Cycle through sub-folders and files in a user-specified root directory
Here is a VBA solution, without using external objects.
Because of the limitations of the Dir()
function you need to get the whole content of each folder at once, not while crawling with a recursive algorithm.
Function GetFilesIn(Folder As String) As Collection
Dim F As String
Set GetFilesIn = New Collection
F = Dir(Folder & "\*")
Do While F <> ""
GetFilesIn.Add F
F = Dir
Loop
End Function
Function GetFoldersIn(Folder As String) As Collection
Dim F As String
Set GetFoldersIn = New Collection
F = Dir(Folder & "\*", vbDirectory)
Do While F <> ""
If GetAttr(Folder & "\" & F) And vbDirectory Then GetFoldersIn.Add F
F = Dir
Loop
End Function
Sub Test()
Dim C As Collection, F
Debug.Print
Debug.Print "Files in C:\"
Set C = GetFilesIn("C:\")
For Each F In C
Debug.Print F
Next F
Debug.Print
Debug.Print "Folders in C:\"
Set C = GetFoldersIn("C:\")
For Each F In C
Debug.Print F
Next F
End Sub
You might find it easier to use the FileSystemObject
, somthing like this
This dumps a folder/file list to the Immediate window
Option Explicit
Sub Demo()
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim Mask As String
Set fso = CreateObject("scripting.FileSystemObject") ' late binding
'Set fso = New FileSystemObject 'or use early binding (also replace Object types)
Set fldStart = fso.GetFolder("C:\Your\Start\Folder") '-- use your FileDialog code here
Mask = "*.xls"
Debug.Print fldStart.Path & "\"
ListFiles fldStart, Mask
For Each fld In fldStart.SubFolders
ListFiles fld, Mask
ListFolders fld, Mask
Next
End Sub
Sub ListFolders(fldStart As Object, Mask As String)
Dim fld As Object 'Folder
For Each fld In fldStart.SubFolders
Debug.Print fld.Path & "\"
ListFiles fld, Mask
ListFolders fld, Mask
Next
End Sub
Sub ListFiles(fld As Object, Mask As String)
Dim fl As Object 'File
For Each fl In fld.Files
If fl.Name Like Mask Then
Debug.Print fld.Path & "\" & fl.Name
End If
Next
End Sub