Dateien je nach Name in Ordner verteilen
02.08.2022 18:51:27
IsaS
ich versuche aktuell Dateien per Makro je nach Dateiname in einen entsprechenden Ordner zu verteilen, zum Beispiel die Dateien "65123456MV.pdf" und "AB65123456" in den Ordner "65123456" und die Dateien "65234567MV.pdf" und "AB65234567" in den Ordner "65234567" usw.
Aktuell gelingt mir nur das Auflisten der Dateinamen in ein Tabellenblatt und das Dazusetzen der dazugehörigen Ordnernamen, doch keine Datei wird verschoben und ich bekomme keine Fehlermeldung. Ich hoffe, ihr könnt mir helfen...
Hier mein aktuelles Marko:
Sub Verschieben()
Dim path As String
Dim fn As String
Dim zeile As Long, i As Long
Dim k As Boolean
Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Quelle As String
Dim Quelle2 As String
Dim Ziel As String
Dim sPath As String
zeile = 1
Cells.ClearContents
Cells(1, 1) = "Dateien"
Cells(1, 3) = "Verzeichnis"
path = ThisWorkbook.path & "\NEU\"
'Dateinamen in Tabelle schreiben
Quelle = Dir(path & "*.pdf")
Do While Quelle ""
zeile = zeile + 1
Cells(zeile, 1) = Quelle
Quelle = Dir()
Loop
'gleichnamige Verzeichnisse angeben
For i = 2 To zeile
Quelle2 = path & Cells(i, 1)
Cells(i, 3) = Quelle2
Ziel = path & Left(Cells(i, 1), 8) & "\" & Cells(i, 1)
Cells(i, 4) = Ziel
Next i
'Dateien verschieben
On Error Resume Next
For i = 2 To zeile
If (Cells(i, 1)) "" Then
FileCopy Quelle2, Ziel
End If
Next i
End Sub