VBA Makro zum Suchen von PDFs
11.10.2021 13:22:31
PDFs
ich habe damals hier im Forum einen sehr guten Codeschnipsel gefunden, wie ich anhand eines Zellwertes in einem Ordner nach der PDF Datei suchen kann und sie in einem bestimmten Ordner zu kopieren.
Jetzt ist es so, dass ich nicht nur ein Ordner habe, sondern leider mehrere Ordner.
Ich muss parallel in 3 Ordner suchen.
Der Zellwert in A1 lautet zum Beispiel test1 und die PDF Datei heißt manchmal test1_db, aber wenn test1 im PDF Name enthalten ist, sollte auch die PDF hier test1_db kopiert werden, um es dementsprechend in einem Ordner zu kopieren.
Hier mein Ansatz, der leider nicht zum Erfolg führt.
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
Anzeige