Hallo Zusammen,

ich benötige nochmal Eure Hilfe.

Ich baue gerade eine Datei, die eine Kundennummer aus der Zelle A2 mit einer .pdf Datei im U Laufwerk abgleicht und falls diese Vorhanden ist dupliziert und in ein anderen Ordner verschiebt und umbenennt (Name kommt aus Zelle B2).

Meine Datei ist soweit fertig, jedoch gibt es einige Dateien, die nicht genauso heißen wie die Zelle A2 und daher funktioniert meine Funktion nicht mehr, da dieser explizit nach den richtigen Namen sucht. (z.B. ist die Kundennummer 123456 und die Datei heißt FirmaXYGmbH_123456_XXX.pdf)

Ich benötige also eine Funktion, die nach Dateien sucht, die die Kundennummer beinhalten.

Ich habe meinen Code mal angehängt. Beachtet die Fett gedruckten, da denke ich das was verändert werden muss, ich habe jedoch keine Ahnung was.

Für jede Hilfe bin ich dankebar!

Sub Ordner()
Do

Dim FSO As New FileSystemObject

'Prüfen ob Datei vorhanden auf dem Laufwerk, falls ja, dann verschieben und umbenennen

If FSO.FileExists("U:\Automatisierung\STARTORT\" & Range("A2") & ".pdf") Then

    FSO.CopyFile "U:\Automatisierung\STARTORT\" & Range("A2") & ".pdf", "U:\Automatisierung\ZIELORT\" & Range("B2") & ".pdf"

'Falls nicht vorhanden dann in Liste für Fehlermeldungen übertragen

      Else
      
     Sheets("Fehlermeldung").Select

Dim last As Integer
last = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(last, 1).Value = Sheets("Daten").Range("A2").Value

last = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(last, 2).Value = Sheets("Daten").Range("B2").Value

    Sheets("Daten").Select

    End If
    

'Reihe 2 löschen
Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    
'Wiederholen bis Reihe 2 keinen Wert mehr hat (Liste ist fertig)
    
Loop Until Range("A2").Value = ""

End Sub