20.11.2023, 20:18
Hallo zusammen; ?
ich wollte mir gerne ein Makro erstellen, um aus Excel mehrere PDF Dateien aus einem Dateipfad an unterschiedliche Speicherorte zu verschieben und dabei die Dateien umzubenennen.
Die Dateinamen, aus dem die Dateien welche verschoben und umbenannt werden sollen, sind als Dateiname mit Zahlen versehen. Diese Zahlen sind allerdings nicht immer fortlaufend. Es soll mit der Datei mit der kleinsten Zahl begonnen und sich dann aufsteigend fortgearbeitet werden.
Der Speicherort, indem sich die Dateien befinden steht, ist im Macrocoe hinterlegt:
' Quellordnerpfad festlegen
Const sourcePath As String = "C:\Users\S7ebe\Desktop\DateienAbspeichern" '
Die unterschiedlichen Speicherorte inkl. neuem Dateinamen, wo die Dateien verschoben und dementsprechend umbeannt werden sollen, steht in der Spalte B10 bis B22. Es kann manchmal sein, dass in B18 und B19 nichts steht, dann soll mit B20 bis B22 fortgefahrten werden.
Hier ist noch ein Beispiel zum besseren Verständnis. Durchsuche den Dateipfad aus dem Makro:
Const sourcePath As String = "C:\Users\S7ebe\Desktop\DateienAbspeichern" und nimm daraus als erstes die Datei (pdf) mit der geringsten Zahl im Dateinamen. Verschiebe diese Datei in den Speierort B10 und benenne die Datei wie sie auch im Dateipfad B10 zum Schluss steht. Dann nimmst du die nächste Datei (nächst größere vorhandene Zahl im Dateinamen) aus dem Dateipfad vom Makro und fahre mit dem neuen Speierort aus B11 und Datenamen fort. Arbeite nach dem Schema alle Dateien aus dem Dateipfad bis zum Speicherort aus B22 ab.
Zur Info:
Der neue Speicherort von B10 bis B22 setzen sich aus Formeln zusammen.
Der Fehler ist anscheinend bei
' Verschieben und Umbenennen der gefundenen Datei im Zielordner
fso.MoveFile quellOrdnerPfad & "\" & dateiName, zielOrdnerPfad & "\" & neuerDateiName
dort bleibt zumindest das Makro stehen.
Ich habe darauf mal den Speicherort, welcher aus Formeln (verketten) zusammengesetzt ist, einfach mal ohne Formeln in B10 bis B22 geschrieben und siehe da, das ausschneiden und umbenennen funktioniert tadellos.
Was könnte ich ändern damit dies auch mit einem Zielpfad, welcher sich aus Formeln zusammensetzt, funktioniert?
Hier wäre der Code, welchen ich bis jetzt habe.
Über Hilfe wäre ich sehr dankbar. ?
Sub DateienVerschiebenUndUmbenennen()
Dim fso As Object
Dim quellOrdnerPfad As String
Dim zielOrdnerPfad As String
Dim dateiName As String
Dim neuerDateiName As String
Dim i As Integer
' Quellordnerpfad festlegen
quellOrdnerPfad = "C:\Users\S7ebe\Desktop\DateienAbspeichern" ' Anpassen Sie dies entsprechend
Set fso = CreateObject("Scripting.FileSystemObject")
' Schleife von B10 bis B22
For i = 10 To 22
' Zielverzeichnis-Pfad aus Zelle B(i)
zielOrdnerPfad = Left(Range("B" & i).Value, InStrRev(Range("B" & i).Value, "\") - 1)
' Überprüfen, ob der Zielordnerpfad vorhanden ist und ein Dateiname in B(i) angegeben ist
If zielOrdnerPfad <> "" And Range("B" & i).Value <> "" Then
' Überprüfen, ob der Quellordner existiert
If fso.FolderExists(quellOrdnerPfad) Then
dateiName = Dir(quellOrdnerPfad & "\*.pdf") ' Nur PDF-Dateien im Quellordner berücksichtigen
' Überprüfen, ob eine PDF-Datei gefunden wurde
If dateiName <> "" Then
' Neuen Dateinamen aus Zelle B(i) extrahieren
neuerDateiName = Right(Range("B" & i).Value, Len(Range("B" & i).Value) - InStrRev(Range("B" & i).Value, "\"))
' Verschieben und Umbenennen der gefundenen Datei im Zielordner
fso.MoveFile quellOrdnerPfad & "\" & dateiName, zielOrdnerPfad & "\" & neuerDateiName
Else
MsgBox "Keine PDF-Dateien im Quellordner gefunden!"
End If
Else
MsgBox "Quellordner nicht gefunden!"
End If
End If
Next i
Set fso = Nothing
End Sub
ich wollte mir gerne ein Makro erstellen, um aus Excel mehrere PDF Dateien aus einem Dateipfad an unterschiedliche Speicherorte zu verschieben und dabei die Dateien umzubenennen.
Die Dateinamen, aus dem die Dateien welche verschoben und umbenannt werden sollen, sind als Dateiname mit Zahlen versehen. Diese Zahlen sind allerdings nicht immer fortlaufend. Es soll mit der Datei mit der kleinsten Zahl begonnen und sich dann aufsteigend fortgearbeitet werden.
Der Speicherort, indem sich die Dateien befinden steht, ist im Macrocoe hinterlegt:
' Quellordnerpfad festlegen
Const sourcePath As String = "C:\Users\S7ebe\Desktop\DateienAbspeichern" '
Die unterschiedlichen Speicherorte inkl. neuem Dateinamen, wo die Dateien verschoben und dementsprechend umbeannt werden sollen, steht in der Spalte B10 bis B22. Es kann manchmal sein, dass in B18 und B19 nichts steht, dann soll mit B20 bis B22 fortgefahrten werden.
Hier ist noch ein Beispiel zum besseren Verständnis. Durchsuche den Dateipfad aus dem Makro:
Const sourcePath As String = "C:\Users\S7ebe\Desktop\DateienAbspeichern" und nimm daraus als erstes die Datei (pdf) mit der geringsten Zahl im Dateinamen. Verschiebe diese Datei in den Speierort B10 und benenne die Datei wie sie auch im Dateipfad B10 zum Schluss steht. Dann nimmst du die nächste Datei (nächst größere vorhandene Zahl im Dateinamen) aus dem Dateipfad vom Makro und fahre mit dem neuen Speierort aus B11 und Datenamen fort. Arbeite nach dem Schema alle Dateien aus dem Dateipfad bis zum Speicherort aus B22 ab.
Zur Info:
Der neue Speicherort von B10 bis B22 setzen sich aus Formeln zusammen.
Der Fehler ist anscheinend bei
' Verschieben und Umbenennen der gefundenen Datei im Zielordner
fso.MoveFile quellOrdnerPfad & "\" & dateiName, zielOrdnerPfad & "\" & neuerDateiName
dort bleibt zumindest das Makro stehen.
Ich habe darauf mal den Speicherort, welcher aus Formeln (verketten) zusammengesetzt ist, einfach mal ohne Formeln in B10 bis B22 geschrieben und siehe da, das ausschneiden und umbenennen funktioniert tadellos.
Was könnte ich ändern damit dies auch mit einem Zielpfad, welcher sich aus Formeln zusammensetzt, funktioniert?
Hier wäre der Code, welchen ich bis jetzt habe.
Über Hilfe wäre ich sehr dankbar. ?
Sub DateienVerschiebenUndUmbenennen()
Dim fso As Object
Dim quellOrdnerPfad As String
Dim zielOrdnerPfad As String
Dim dateiName As String
Dim neuerDateiName As String
Dim i As Integer
' Quellordnerpfad festlegen
quellOrdnerPfad = "C:\Users\S7ebe\Desktop\DateienAbspeichern" ' Anpassen Sie dies entsprechend
Set fso = CreateObject("Scripting.FileSystemObject")
' Schleife von B10 bis B22
For i = 10 To 22
' Zielverzeichnis-Pfad aus Zelle B(i)
zielOrdnerPfad = Left(Range("B" & i).Value, InStrRev(Range("B" & i).Value, "\") - 1)
' Überprüfen, ob der Zielordnerpfad vorhanden ist und ein Dateiname in B(i) angegeben ist
If zielOrdnerPfad <> "" And Range("B" & i).Value <> "" Then
' Überprüfen, ob der Quellordner existiert
If fso.FolderExists(quellOrdnerPfad) Then
dateiName = Dir(quellOrdnerPfad & "\*.pdf") ' Nur PDF-Dateien im Quellordner berücksichtigen
' Überprüfen, ob eine PDF-Datei gefunden wurde
If dateiName <> "" Then
' Neuen Dateinamen aus Zelle B(i) extrahieren
neuerDateiName = Right(Range("B" & i).Value, Len(Range("B" & i).Value) - InStrRev(Range("B" & i).Value, "\"))
' Verschieben und Umbenennen der gefundenen Datei im Zielordner
fso.MoveFile quellOrdnerPfad & "\" & dateiName, zielOrdnerPfad & "\" & neuerDateiName
Else
MsgBox "Keine PDF-Dateien im Quellordner gefunden!"
End If
Else
MsgBox "Quellordner nicht gefunden!"
End If
End If
Next i
Set fso = Nothing
End Sub