Вот хорошее, общее решение, которое может удовлетворить практически любую папку поиска и ее требования к подпапкам.Это функция, которая вызывает себя рекурсивно и выводит объект словаря, содержащий полные результаты, код для ясности прокомментирован:
Public Function SearchDirectory(ByVal arg_sFolderPath As String, _
Optional ByVal arg_sSearch As String = "*", _
Optional ByVal arg_bMatchCase As Boolean = False, _
Optional ByVal arg_bIncludeSubFolders As Boolean = True, _
Optional ByRef arg_hResults As Object) _
As Object
'Purpose of this function is to search a directory (and probably all of its subfolders)
'for files that match an optionally provided search string, and the match may or may
'not be case sensitive. It then collects all of the results in a dictionary object and
'returns that dictionary object as the function output
'
'Parameters:
' arg_sFolderPath: [Required][String] -The folder path of the original directory that will be searched
'
' arg_sSearch: [Optional][String] -A pattern that will be matched against.
' -For example, to find all Excel files you would use "*.xls*"
' -Default value is "*" which will return all files
'
' arg_bMatchCase: [Optional][Boolean] -Specifies whether or not to match arg_sSearch as case sensitive
' -For example, if this is set to True and the arg_sSearch is set to "*.xls*",
' then an Excel file named "EXCELFILE.XLSX" would NOT be found
' -Default value is False which will make matches not case sensitive
'
' arg_bIncludeSubFolders [Optional][Boolean] -Specifies whether or not to search all subfolders recursively
' -Default value is True which will include results in all subfolders
'
' arg_hResults [Optional][Dictionary Object] -An existing dictionary object to hold the results in
' -Typically this will not be provided on initial call, and is used
' during recursive calls to store all relevant results for output
'
'Author: tigeravatar on stackoverflow at /9662703/perebrat-vse-podpapki
'Created: July 10, 2019
'Static so that during recursive search it doesn't need to be recreated on every recursive call
Static oFSO As Object
If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")
'Check if arg_hResults was provided (typically not on first call, but will be on all subsequent recursive calls)
'This preserves all found matching file results throughout all recursive calls of the function
Dim hResults As Object
If arg_hResults Is Nothing Then Set hResults = CreateObject("Scripting.Dictionary") Else Set hResults = arg_hResults
'Variable used to store the folder path separator
Dim sPS As String
sPS = Application.PathSeparator
'Adjust so that even if folder path isn't passed with an ending Path Separator, the function can handle it appropriately
Dim sFolderPath As String
If Right(arg_sFolderPath, Len(sPS)) = sPS Then sFolderPath = arg_sFolderPath Else sFolderPath = arg_sFolderPath & sPS
'Verify the folder path provided is valid. Allow for hidden folders to be searched as well
If Len(Dir(sFolderPath, vbDirectory + vbHidden)) = 0 Then
MsgBox "Invalid directory path provided: " & Chr(10) & arg_sFolderPath, , "Search Directory Error"
Set SearchDirectory = Nothing
Exit Function
End If
'Using the FileSystemObject, work with the provided and validated folder path
Dim oFolder As Object
Set oFolder = oFSO.GetFolder(sFolderPath)
'Loop through all files in the folder
Dim oFile As Object
Dim bMatch As Boolean
For Each oFile In oFolder.Files
'Verify the file matches the provided search pattern (if any) according to case sensitivity
bMatch = False
If arg_bMatchCase = True Then
If oFile.Name Like arg_sSearch Then bMatch = True
Else
If LCase(oFile.Name) Like LCase(arg_sSearch) Then bMatch = True
End If
'If match found, add it to the hResults dictionary
If bMatch = True Then
If Not hResults.Exists(oFile.Path) Then hResults.Add oFile.Path, oFile.Path
End If
Next oFile
'If set to search subfolders (default behavior), have the function recursively call itself to search all subfolders
If arg_bIncludeSubFolders = True Then
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
Set hResults = SearchDirectory(oSubFolder.Path, arg_sSearch, arg_bMatchCase, arg_bIncludeSubFolders, hResults)
Next oSubFolder
End If
'Set function output to the hResults dictionary if it contains any matched file results
If hResults Is Nothing Then
Set SearchDirectory = Nothing
Else
If hResults.Count = 0 Then Set SearchDirectory = Nothing Else Set SearchDirectory = hResults
End If
End Function
Это пример того, как использовать функцию и работать с ее результатами:
Sub tgr()
'Create an object variable and set it to the function SearchDirectory
'Provide SearchDirectory arguments as desired
Dim hFoundFiles As Object
Set hFoundFiles = SearchDirectory("C:\Test")
'Verify it actually found files matching your criteria in the folder specified
If hFoundFiles Is Nothing Then Exit Sub 'Didn't return any results
'Can output results to a worksheet
ActiveWorkbook.ActiveSheet.Range("A1").Resize(hFoundFiles.Count).Value = Application.Transpose(hFoundFiles.Keys)
'Can loop through each result if you need to do something with them individually
Dim vFile As Variant
For Each vFile In hFoundFiles.Keys
'Do something here
Debug.Print vFile
Next vFile
End Sub