VBA查找多个文件

我有这段代码，它根据搜索字符串查找文件名（以及文件路径）。这段代码在查找单个文件时效果很好。我希望这个宏能够查找多个文件并使用逗号分隔显示它们的名称。

Function FindFiles(path As String, SearchStr As String)

          Dim FileName As String   ' Walking filename variable.
          Dim DirName As String    ' SubDirectory Name.
          Dim dirNames() As String ' Buffer for directory name entries.
          Dim nDir As Integer      ' Number of directories in this path.
          Dim i As Integer         ' For-loop counter.
          Dim Name As String
          Dim Annex As String

          On Error GoTo sysFileERR
          If Right(path, 1) <> "\" Then path = path & "\"
          ' Search for subdirectories.
          nDir = 0
          ReDim dirNames(nDir)
          DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
    Or vbSystem)  ' Even if hidden, and so on.
          Do While Len(DirName) > 0
             ' Ignore the current and encompassing directories.
             If (DirName <> ".") And (DirName <> "..") Then
                ' Check for directory with bitwise comparison.
                If GetAttr(path & DirName) And vbDirectory Then
                   dirNames(nDir) = DirName
                   DirCount = DirCount + 1
                   nDir = nDir + 1
                   ReDim Preserve dirNames(nDir)
                   'List2.AddItem path & DirName ' Uncomment to list
                End If                           ' directories.
    sysFileERRCont:
             End If
             DirName = Dir()  ' Get next subdirectory.
          Loop

          ' Search through this directory and sum file sizes.
          FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
          Or vbReadOnly Or vbArchive)
          'Sheet1.Range("C1").Value2 = path & "\" & FileName
          While Len(FileName) <> 0
             FindFiles = path & "\" & FileName
             FileCount = FileCount + 1
             ' Load List box
            ' Sheet1.Range("A1").Value2 = path & FileName & vbTab & _
                FileDateTime(path & FileName)   ' Include Modified Date
             FileName = Dir()  ' Get next file.
          Wend

          ' If there are sub-directories..
          If nDir > 0 Then
             ' Recursively walk into them
             For i = 0 To nDir - 1
               FindFiles = path & "\" & FileName
             Next i
          End If

    AbortFunction:
          Exit Function
    sysFileERR:
          If Right(DirName, 4) = ".sys" Then
            Resume sysFileERRCont ' Known issue with pagefile.sys
          Else
            MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
             "Unexpected Error"
            Resume AbortFunction
          End If
          End Function



          Sub Find_Files()
          Dim SearchPath As String, FindStr As String, SearchPath1 As String
          Dim FileSize As Long
          Dim NumFiles As Integer, NumDirs As Integer
          Dim Filenames As String, Filenames1 As String
          Dim r As Range
          'Screen.MousePointer = vbHourglass
          'List2.Clear

          For Each cell In Range("SS")
          SearchPath = Sheet3.Range("B2").Value2
          SearchPath1 = Sheet3.Range("B3").Value2

          FindStr = Cells(cell.Row, "H").Value
          Filenames = FindFiles(SearchPath, FindStr)
          Filenames1 = FindFiles(SearchPath1, FindStr)
          'Sheet1.Range("B1").Value2 = NumFiles & " Files found in " & NumDirs + 1 & _
           " Directories"
          Cells(cell.Row, "F").Value = Filenames
          Cells(cell.Row, "G").Value = Filenames1

          'Format(FileSize, "#,###,###,##0") & " Bytes"
          'Screen.MousePointer = vbDefault
          Next cell

          End Sub

任何想法都将受到高度赞赏。

我意识到这个问题很老了，但没有答案。这是查找多个文件及其路径的快速方法。 VBA的DIR功能不是很方便，但是 CMD 的DIR功能 http://ss64.com/nt/dir.html进行了很好的优化，并具有大量的命令行开关，使其仅返回符合您条件的文件（甚至只是文件夹）。诀窍是call DIR从 WScript shell https://blogs.technet.microsoft.com/heyscriptingguy/2004/08/10/how-can-i-call-the-dir-command/以便VBA可以解析输出。

例如，这段代码将找到系统上以config.

Dim oShell As Object 'New WshShell if you want early binding
Dim cmd As Object 'WshExec if you want early binding
Dim x As Integer
Const WshRunning = 0

Set oShell = CreateObject("Wscript.Shell")
Set cmd = oShell.Exec("cmd /c ""Dir c:\config* /a:-d /b /d /s""")

Do While cmd.Status = WshRunning
    DoEvents
Loop

Debug.Print cmd.StdOut.ReadAll
Set oShell = Nothing
Set cmd = Nothing