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

Tags:

Excel

Vba