alte Dateien per Batch verschieben aber relative Struktur beibehalten

Pushd C:\Quelle
delage32 * 35 /recurse /move c:\Ziel /preview
Popd

' [content:147586#580079]  
' Script zum Verschieben von "alten" Dateien in ein anderes Verzeichnis und Link im Originalverzeichnis erstellen  
' THX Tsuki ([content:79798])  
' THX Friemler ([content:91808])  


Dim OrgPfad, ArcPfad, Logdatei
Dim Logbucheintrag, Logbuchkopf, trennlinie
Dim DatName, LinkPfad
Dim ObjShell

Dim objShortcut

'Angabe mit Backslash "\" -> Bsp: c:\programme\  

OrgPfad = "C:\ArchivTest\OrigDat\"  
ArcPfad = "C:\ArchivTest\ArcDat\"  
logdatei = "C:\ArchivTest\archivierung-"&Date()&".txt"  
trennlinie = "*****************************************"  


'Subroutine Ordner ArcPfad vorhanden  
Archivordnerpruefung

set fs = createobject("Scripting.FileSystemObject")  

ListOrdner (OrgPfad)

'''''''''''''''''''''''''''''''''''''''''''''''''''  
' Logfile Bearbeitung                             '  
'''''''''''''''''''''''''''''''''''''''''''''''''''  
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")  

' Logeintrag schreiben  
	Const ForReading = 1
	Const ForWriting = 2

'Prüfung, ob Logdatei vorhanden, ansonsten erstelle mit Datum in Kopfzeile  
  If (objFSO.FileExists(logdatei)) Then
	Set open_File = objFSO.OpenTextFile(logdatei, 8)
    	open_File.Close()
	Else
    	Set open_File = objFSO.OpenTextFile(logdatei, 2, "True")  
    	open_File.Close()
	End If

	Set objLogFile = objFSO.OpenTextFile(Logdatei, ForWriting, TRUE)
		Logbuchkopf = trennlinie & vbCrLf _
    	& "Datum der Archivierung: " & Date() & vbCrLf _  
    	& trennlinie & vbCrLf

		objLogFile.Write Logbuchkopf & Logbucheintrag
	' Schliesse Logdatei  
		objLogFile.Close

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Verschieben der Dateien                       ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub ListOrdner(OrgPfad)

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")  

Set ordner = fs.getfolder(OrgPfad)

	For Each file In ordner.files

		OrgPfad = File.path
		temp = Split(OrgPfad , "\")  
		DatName = temp(Ubound(temp))
		Wscript.echo "Datei in Bearbeitung: " & DatName  
		Logbucheintrag = Logbucheintrag & vbCrLf & Time () & " " & OrgPfad  

	' Dateien tatsächlich verschieben  
		LinkPfad = OrgPfad
        FS.MoveFile OrgPfad , ArcPfad
        'Subroutine Link für verschobene Datei anlegen  
        LinkAnlegen

	Next

' Suche der Dateien in Unterordner  
	For Each Unterordner In Ordner.subfolders
		OrgPfad = unterordner.path
		Wscript.echo "Unterpfad existiert: "  
		Wscript.echo "Pfad: " & OrgPfad  

	' Lese auch in Unterordnerstruktur  
		Listordner unterordner

	Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' Prüfung ob Archivordner vorhanden             ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub Archivordnerpruefung()
Dim Ordner

Set fs = CreateObject("Scripting.FileSystemObject")  
	If Not fs.FolderExists(ArcPfad) Then
    	fs.CreateFolder (ArcPfad)
	Else
		'nix machen  
    End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''  
'' für jede verschoben Datei link anlegen        ''  
'''''''''''''''''''''''''''''''''''''''''''''''''''  

Sub LinkAnlegen()

Set ObjShell = CreateObject("WScript.Shell")  

  strLPfad = LinkPfad
  Set objShortcut=objShell.CreateShortcut(strLPfad & ".lnk")  
  objShortcut.TargetPath= ArcPfad & DatName
  objShortcut.Save

End Sub