List Files in Folder and Subfolders with VBA FileSystemObject - wellsr.com
Mon May 06 2024 21:20:52 GMT+0000 (Coordinated Universal Time)
Saved by
@acassell
' 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
content_copyCOPY
https://wellsr.com/vba/2018/excel/list-files-in-folder-and-subfolders-with-vba-filesystemobject/
Comments