VBA- opening and filtering folders

Question

I have the following code which i can loop through all the .dwg files inside a folder.

    Private Sub CommandButton1_Click()
'open file to extract
    Dim MyFolderext As String
    Dim MyFileext As String
    'ficheiro origem
    MyFolderext = "C:\Users\abc\test"
    MyFileext = Dir(MyFolderext & "\*.dwg")
    Do While MyFileext <> ""
    Application.Documents.Open MyFolderext & "\" & MyFileext

'check sub if not enough inputs were placed on the user console
check

'unlock drawing layers
ThisDrawing.Layers("MC_BLOCO_INFO_AREAS").Lock = False
ThisDrawing.Layers("MC_BLOCO_TEXTOS_COMERCIAL").Lock = False
ThisDrawing.Layers("MC_BLOCO_TEXTOS_INV").Lock = False

'sub of the program
program


MyFileext = Dir
    Loop
    
'when finished
MsgBox "Done!"

'sub to clean to console for next operation
clean

End Sub

While it works in all the files inside a folder, I cannot make it work with subfolders and I still would need to filter some of them. So what I am asking is: can you help me changing the code to open all the folders inside the mother folder "C:\Users\abc\test" but skip folders "ignore"?

Edit: I have come up with this, but still not working:

Sub FileSearch(ByRef Folder As Object)
Dim MyFileext As String
Dim File As Object
Dim SubFolder As Object
MyFileext = Dir(MainFolder & "\*.dwg")
Do While MyFileext <> ""
Application.Documents.Open MainFolder & "\" & MyFileext
For Each File In Folder.Files
        programa
Next File
Loop

For Each SubFolder In Folder.SubFolders
    If SubFolder.Name <> "extras" Then
        FileSearch SubFolder 'Recursion
    End If
Next SubFolder
End Sub

Private Sub CommandButton1_Click()
    check
        Dim MainFolder As Object
    Set MainFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\abc\test")
    
    FileSearch MainFolder
    
MsgBox "Done!"

clean

End Sub

Answer 1

You will need to use FileSystemObject to set the folder and files as objects in order to determine if they have subfolders and to be able to check if the subfolders meet your criteria.

Here is an example of how to loop through a folder's files and its subfolders and their files:

Sub test()
    Dim MainFolder As Object, File As Object, SubFolder As Object
    Set MainFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\abc\test\")
    
    For Each File In MainFolder.Files
        'do stuff
    Next File
    For Each SubFolder In MainFolder.Subfolders
        'If SubFolder Meets Your Criteria Then
            For Each File In SubFolder.Files
                'do stuff
            Next File
        'End If
    Next SubFolder
    
End Sub

That example only searches one level deep in subfolders. Here's an example that searches everything:

Sub test()
    Dim MainFolder As Object
    Set MainFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\abc\test\")
    
    FileSearch MainFolder
    
End Sub

Sub FileSearch(ByRef Folder As Object)
    Dim File As Object, SubFolder As Object
    For Each File In Folder.Files
        'do stuff
    Next File
    For Each SubFolder In Folder.SubFolders
        FileSearch SubFolder 'Recursion
    Next SubFolder
End Sub

In response to your comments, here is another example that is my best guess at how to implement my suggestions into your original code.

Const FileExt As String = ".dwg" 'Module-Level Constant

Private Sub CommandButton1_Click()
'open file to extract
    Dim MainFolder As Object
    Set MainFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\abc\test\")
    FileSearch MainFolder
    Clean 'is this a sub of yours?
End Sub

Sub FileSearch(ByRef Folder As Object)
    Dim File As Object, SubFolder As Object
    For Each File In Folder.Files
        If File.Name Like "*" & FileExt Then
            ProcessDwg File
        End If
    Next File
    For Each SubFolder In Folder.SubFolders
        If Not LCase(SubFolder.Name) Like "*ignore*" Then
            FileSearch SubFolder 'Recursion
        End If
    Next SubFolder
End Sub
Sub ProcessDwg(ByRef dwgFile As Object)
    Dim ThisDrawing As Object
    Set ThisDrawing = Application.Documents.Open(dwgFile.Path)
    check 'is this a sub of yours?
    ThisDrawing.Layers("MC_BLOCO_INFO_AREAS").Lock = False
    ThisDrawing.Layers("MC_BLOCO_TEXTOS_COMERCIAL").Lock = False
    ThisDrawing.Layers("MC_BLOCO_TEXTOS_INV").Lock = False
    program 'is this a sub of yours?
End Sub