VBA para encontrar vários arquivos

Eu tenho esse código que localiza nomes de arquivos (junto com caminhos de arquivos) com base na string de pesquisa. Esse código funciona bem para encontrar arquivos únicos. Gostaria que essa macro localizasse vários arquivos e exibisse seus nomes separados por vírgula.

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

Quaisquer pensamentos serão muito apreciados.

questionAnswers(1)

yourAnswerToTheQuestion