in the Range A1:A2 I stored the file name. The files are stored in three different folders.

And the file name start with the search criteria in A1 but is not always match 100 %.

A1 = "test1"

But the pdf documents, which I am looking for call

"test1-e"

, but this is the right one which I need.

After finding the correct pdf in the three folders, I need to copy it to the Source Path.

My approach looks like this:

Sub copyFile()
  Dim objFSO As Object, rng As Range
  
  
  Dim strFileToCopy, strOldPath As String, strOldPath2 As String, strOldPath3 As String, strNewPath As String
  
  strOldPath = "" 'Verzeichnis Nr. 1 in dem die Datei liegt
  strOldPath2 = ""                                             'Verzeichnis Nr. 2 in dem die Datei liegt
  strOldPath3 = ""                                              'Verzeichnis Nr. 3 in dem die Datei liegt
  
  
  strNewPath = ""
  
  With ActiveSheet
  
  For Each rng In Range("A1:A2")
    'strFileToCopy = .Range("A2") 'Zelle mit dem Namen
    
    
    If strFileToCopy Like rng Then
    
        strFileToCopy = rng
    
        strFileToCopy = strFileToCopy & ".pdf" 'Suffix anhängen
    
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        OldPath = objFSO.BuildPath(strOldPath, strFileToCopy)
        If objFSO.FileExists(OldPath) Then
        objFSO.copyFile OldPath, objFSO.BuildPath(strNewPath, strFileToCopy)
    End If

    End If

Next
    
    
    'If Dir(strOldPath & strFileToCopy, vbNormal) <> "" Then
     ' Set objFSO = CreateObject("Scripting.FileSystemObject")
      'objFSO.copyFile strOldPath & strFileToCopy, strNewPath & strFileToCopy
    'End If
    
    
    
  End With
  
  Set objFSO = Nothing
End Sub

But my problem is, how can search in different folders and how can I search with "Like-Expression", because my solution didn't work out. Thanks a lot for the support.

CodePudding user response：

Something along these lines I would use. This returns an array of files.

Function ReturnFiles(strSourceFolder As String, strSearch As String) As Scripting.File()

Dim a() As File
Dim fso As Scripting.FileSystemObject
Dim f As Scripting.Folder
Dim fl As Scripting.File

On Error GoTo eHandle

Set fso = New Scripting.FileSystemObject

If fso.FolderExists(strSourceFolder) Then

    Set f = fso.GetFolder(strSourceFolder)
    
    For Each fl In f.Files
        If Left(fl.Name, Len(strSearch)) = strSearch Then           '   Or instr here for example
            Set a(UBound(a)) = fl
            ReDim Preserve a(UBound(a)   1)
        End If
    Next fl

Else

End If

ReturnFiles = a

HouseKeeping:

Set fl = Nothing
Set f = Nothing
Set fso = Nothing
Erase a

Exit Function

eHandle:

    If Err.Number = 9 Then
        ReDim a(0)
        Resume
    Else
        GoTo HouseKeeping
    End If

End Function