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

Does this answer your question? [Get list of sub-directories in VBA](https://stackoverflow.com/questions/9827715/get-list-of-sub-directories-in-vba) — Nicholas Hunter, May 18 '21 at 14:40

Toddleson · Accepted Answer · 2021-05-18T15:56:22.747

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

to use your code I had to remove the .dwg file type filter and i think that it is applying the program to the subfolders and bugging out? I would like to send you the code I put together, but there is a character limitation — Pedro, May 18 '21 at 15:39
I have added another example that may help you implement my suggestions — Toddleson, May 18 '21 at 15:58
thank you, it's working :D just one quick question, in the line "If Not LCase(SubFolder.Name) Like "*ignore*" Then" how can I add more exceptions? sorry, not familiar with the Like function (if i want to ignore the folder "ignore" and the folder "stop") — Pedro, May 18 '21 at 16:40
`If Not LCase(SubFolder.Name) Like "*ignore*" And Not LCase(SubFolder.Name) Like "*stop*" Then` Unfortunately it doesn't have full RegExp functionality so you cant define a match pattern like "(ignore)|(stop)" — Toddleson, May 18 '21 at 17:27

VBA- opening and filtering folders

1 Answers1