Dateien umbenennen und verschieben mit VBS

CreateObject("WScript.Shell").Run logdat  

'P F A D E   A N F A N G =============================================================================================================  

quelle = "E:\Scanordner\"			'Pfad inkl. \  
ziel = "E:\Objekte\"				'Pfad inkl. \  
zielpfad = "\11_laufende_Buchhaltung\Rechnungen\Eingangsrechnungen\"	'Pfadteil nach der Objektnummer - Beginn und Ende mit \  

'P F A D E   E N D E =============================================================================================================  

'U S E R N A M E   A U S L E S E N  
Set objNetwork = CreateObject("WScript.Network")  
username = objNetwork.UserName
'msgbox(Username)  

'D A T U M    U N D   Z E I T    F E S T L E G E N    U N D   F O R M A T I E R E N  
DD = Date
dt = Year(DD) & "-" & Right("0" & Month(DD), 2) & "-" & Right("0" & Day(DD), 2)  

ZZ = Time
zt = Left(ZZ, 2) & "-" & Mid(ZZ, 4, 2) & "-" & Right(ZZ, 2)  

'L O G D A T E I   F E S T L E G E N  
logdat = "e:\Scanordner\" & username & "\log_" & dt & "_" & zt & ".txt"  
'msgbox(logdat)  

'Q U E L L P F A D   D E S   U S E R S   F E S T L E G E N  
quellpfad = quelle & username & "\"  
'msgbox(quellpfad)  

'D A T E I E N   A B F R A G E N  
on error resume next
set fs = CreateObject("Scripting.FileSystemObject")  
set f = fs.GetFolder(quellpfad)
Set y = fs.CreateTextFile(logdat, True)

For Each file in f.Files

if right(file.Name, 4) = ".pdf" then							'nur PDFs bearbeiten  

	alt = file.Name									'alten Namen speichern  
	'msgbox(alt)  
	CreateObject("WScript.Shell").Run quellpfad & alt				'PDF zur Info öffnen  
	Set shell = WScript.CreateObject("WScript.Shell")   

	Do
		WScript.Sleep 1000
		onr = InputBox("Objektnummer bitte angeben:", "Objektnummer", onr)  
		rdat = InputBox("Rechnungsdatum bitte angeben (TTMMJJ):", "Rechnungsdatum", rdat)  
		korr = InputBox("Eingaben korrekt?" & vbCrLf & "Objektnummer: " & onr & vbCrLf & "Datum: " & left(rdat, 2) &_  
		"." & mid(rdat,3,2) & ".20" &right(rdat,2), "Eingabekontrolle", "ja")  
	Loop While LCase(Left(korr, 1)) <> "j"  

	i = 1										'Zähler auf 1 stellen  
	Do Until fs.FileExists(ziel & onr & zielpfad & onr & "_Rechnung_vom_20" & right(rdat,2) & mid(rdat,3,2) & left(rdat, 2) & "_" & Right("0" & i, 2) & ".pdf") = False: i = i + 1:  Loop 'nächste freie Nummer suchen  

	shell.appactivate(quellpfad & alt)
	shell.sendkeys ("%{F4}"), true 							'wie ALT+F4  
	WScript.Sleep 100 								'Wichtig!!!	  

	file.Name = onr & "_Rechnung_vom_20" & right(rdat,2) & mid(rdat,3,2) & left(rdat, 2) & "_" & Right("0" & i, 2) & ".pdf"  
	neu = file.Name
	'msgbox(neu)  

	if fs.FolderExists(ziel & ONR & zielpfad) then
		if quellpfad <> ziel & ONR & zielpfad then								'Zielverzeichnis darf nicht gleich Quelle sein  
			file.move (ziel & ONR & zielpfad)						'ins Zielverzeichnis verschieben  
			y.WriteLine(quellpfad & alt & " >>> " & ziel & onr & zielpfad & neu & " <<< +v+u")		'Wenn der Ordner existiert wurde die Datei verschoben + protokolliert  
		else
			fs.CreateFolder(quellpfad & "fertig\")						'Ordner erzeugen, da Ziel gleich Quelle  
			file.move (quellpfad & "fertig\")							'in neuen Ordner verschieben  
			y.WriteLine(quellpfad & alt & " >>> " & quellpfad & "fertig\" & neu & " <<< -v+u Quelle gleich Ziel")	'Wenn Ziel gleich Quelle wird nur die Namensänderung protokolliert  

		end if
	else
		fs.CreateFolder(quellpfad & "fertig\")						'Ordner erzeugen, da Ziel nicht vorhanden ist  
		file.move (quellpfad & "fertig\")							'in neuen Ordner verschieben  
		y.WriteLine(quellpfad & alt & " >>> " & quellpfad & "fertig\" & neu & " <<< -v+u kein Ziel vorhanden")	'Wenn der Ordner nicht existiert wird nur die Namensänderung protokolliert  
	end if

End if

Next

y.Close											'Logdatei schließen  

CreateObject("WScript.Shell").Run logdat						'Logdatei anzeigen