VBA: MoveFile - Datei behalten
12.12.2018 23:31:47
Alex
ich bin gerade dabei in VBA ein Skript zu erstellen, mit dessen Hilfe ich meine Festplatte nach bestimmten Dateien durchsuchen kann. Diese sollen mittels MoveFile in einen speziellen Zielordner verschoben werden.
Es kann jedoch passieren, dass eine Datei mehrfach in verschiedenen Ordnern bzw. Unterordner existiert. Ich möchte die Dateien aber nicht schlicht überschreiben, sondern möchte die Gelegenheit haben, diese manuell zu überprüfen.
Ich suche daher eine Möglichkeit, die Dateien - sofern vorhanden - im Quellordner umzubenennen, und zwar mit Hilfe einer fortlaufenden Nummer.
Folgendes funktionierendes Skript habe ich bisher erstellt (sobald aber eine Datei im Zielordner existiert, erscheint der bzw. mittels 'On Error Resume Next' wird die Datei übersprungen.
Über Hilfestellung und Tipps würde ich mich freuen ...
Public FSO As New FileSystemObject
Sub Test1()
Dim Ordner As Folder
Dim Datei As File
Const Startordner = "C:\ZZZ_Startordner"
Const Zielordner = "C:\ZZZ_Zielordner"
Set Ordner = FSO.GetFolder(Startordner)
For Each Ordner In FSO.GetFolder(Startordner).SubFolders
For Each Datei In Ordner.Files
Quellordner = Ordner & "\"
Speicherdatum = FileDateTime(Datei)
Jahr = Mid(Speicherdatum, 7, 4)
Monat = Mid(Speicherdatum, 4, 2)
Tag = Left(Speicherdatum, 2)
Dateityp = FSO.GetExtensionName(Datei)
ZielordnerNeu = Zielordner & "\" & Dateityp & "\" & Jahr & "\" & Monat & "\" & Tag & _
If Dir(Zielordner, vbDirectory) = "" Then
MkDir (Zielordner)
End If
If Dir(Zielordner & "\" & Dateityp & "\", vbDirectory) = "" Then
MkDir (Zielordner & "\" & Dateityp & "\")
End If
If Dir(Zielordner & "\" & Dateityp & "\" & Jahr & "\", vbDirectory) = "" Then
MkDir (Zielordner & "\" & Dateityp & "\" & Jahr & "\")
End If
If Dir(Zielordner & "\" & Dateityp & "\" & Jahr & "\" & "\" & Monat & "\", _
vbDirectory) = "" Then
MkDir (Zielordner & "\" & Dateityp & "\" & Jahr & "\" & Monat & "\")
End If
If Dir(Zielordner & "\" & Dateityp & "\" & Jahr & "\" & "\" & Monat & "\" & Tag & "\ _
", vbDirectory) = "" Then
MkDir (Zielordner & "\" & Dateityp & "\" & Jahr & "\" & Monat & "\" & "\" & Tag & "\ _
")
End If
'On Error Resume Next
If Dateityp = "docx" Then FSO.MoveFile Quellordner & Datei.Name, ZielordnerNeu & _
Datei.Name
Next Datei
Next Ordner
End Sub