Mam ten kod, który znajduje nazwy plików (wraz ze ścieżkami do plików) w oparciu o ciąg wyszukiwania. Ten kod działa poprawnie w poszukiwaniu pojedynczych plików. Chciałbym, aby to makro znalazło wiele plików i aby ich nazwy były wyświetlane oddzielone przecinkiem.

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

Wszelkie myśli będą bardzo mile widziane.