VBA- opening and filtering folders - vba

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