List Files in Folder and Subfolders with VBA FileSystemObject - wellsr.com

' Variable declarations
Dim blNotFirstIteration As Boolean
Dim Fil As File
Dim hFolder As Folder, SubFolder As Folder
Dim FileExt As String
Dim FSO As Scripting.FileSystemObject

' Recursive procedure for iterating through all files in all subfolders
' of a folder and locating specific file types by file extension.
Sub FindFilesInFolders(ByVal HostFolder As String, FileTypes As Variant)
'(1) This routine uses Early Binding so you must add reference to Microsoft Scripting Runtime:
' Tools > References > Microsoft Scripting Runtime
'(2) Call procedure using a command like:
' Call FindFilesInFolders("C:\Users\MHS\Documents", Array("xlsm", "xlsb"))
    If FSO Is Nothing Then Set FSO = New Scripting.FileSystemObject
    Set hFolder = FSO.GetFolder(HostFolder)

    ' iterate through all files in the root of the main folder
    If Not blNotFirstIteration Then
      For Each Fil In hFolder.Files
          FileExt = FSO.GetExtensionName(Fil.Path)
    
          ' check if current file matches one of the specified file types
          If Not IsError(Application.Match(FileExt, FileTypes, 0)) Then
              ' ****************************************
              ' Insert your code here
              ' ****************************************
              Cells(WorksheetFunction.CountA(Range("A:A")) + 1, 1) = Fil.Path
          End If
      Next Fil
    
      ' make recursive call, if main folder contains subfolder
      If Not hFolder.SubFolders Is Nothing Then
          blNotFirstIteration = True
          Call FindFilesInFolders(HostFolder, FileTypes)
      End If
    
    ' iterate through all files in all the subfolders of the main folder
    Else
      For Each SubFolder In hFolder.SubFolders
          For Each Fil In SubFolder.Files
              FileExt = FSO.GetExtensionName(Fil.Path)
    
              ' check if current file matches one of the specified file types
              If Not IsError(Application.Match(FileExt, FileTypes, 0)) Then
                  ' ****************************************
                  ' Insert your code here
                  ' ****************************************
                  Cells(WorksheetFunction.CountA(Range("A:A")) + 1, 1) = Fil.Path
              End If
          Next Fil
    
          ' make recursive call, if subfolder contains subfolders
          If Not SubFolder.SubFolders Is Nothing Then _
              Call FindFilesInFolders(HostFolder & "\" & SubFolder.Name, FileTypes)
    
      Next SubFolder
    End If
    blNotFirstIteration = False
End Sub