VBA Scripting.FileSystemObject Recursively enumerate folders and files


Example

Early Bound (with a reference to Microsoft Scripting Runtime)

Sub EnumerateFilesAndFolders( _
    FolderPath As String, _
    Optional MaxDepth As Long = -1, _
    Optional CurrentDepth As Long = 0, _
    Optional Indentation As Long = 2)
  
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
    
    'Check the folder exists
    If FSO.FolderExists(FolderPath) Then
        Dim fldr As Scripting.Folder
        Set fldr = FSO.GetFolder(FolderPath)
        
        'Output the starting directory path
        If CurrentDepth = 0 Then
          Debug.Print fldr.Path
        End If
        
        'Enumerate the subfolders
        Dim subFldr As Scripting.Folder
        For Each subFldr In fldr.SubFolders
            Debug.Print Space$((CurrentDepth + 1) * Indentation) & subFldr.Name
            If CurrentDepth < MaxDepth Or MaxDepth = -1 Then
                'Recursively call EnumerateFilesAndFolders
                EnumerateFilesAndFolders subFldr.Path, MaxDepth, CurrentDepth + 1, Indentation
            End If
        Next subFldr
        
        'Enumerate the files
        Dim fil As Scripting.File
        For Each fil In fldr.Files
            Debug.Print Space$((CurrentDepth + 1) * Indentation) & fil.Name
        Next fil
    End If
End Sub

Output when called with arguments like: EnumerateFilesAndFolders "C:\Test"

C:\Test
  Documents
    Personal
      Budget.xls
      Recipes.doc
    Work
      Planning.doc
  Downloads
    FooBar.exe
  ReadMe.txt

Output when called with arguments like: EnumerateFilesAndFolders "C:\Test", 0

C:\Test
  Documents
  Downloads
  ReadMe.txt

Output when called with arguments like: EnumerateFilesAndFolders "C:\Test", 1, 4

C:\Test
    Documents
        Personal
        Work
    Downloads
        FooBar.exe
    ReadMe.txt