Unterverzeichnisse finden und umbenennen und Dateien verschieben

Dim Ordner
Dim NeuPfad()
Dim PfadBisEbeneZwei(100) , IPfade2
Dim PfadBisEbeneDrei(100) , IPfade3
Dim PfadKomplett(100,1)
Dim Pfad5_7_Anhaengsel , Pfad5_8_Anhaengsel
Dim NeuOrdner5_9_Neu
Dim SucheStrA , SucheStrB
Dim PfadAngabe

Ordner = InputBox("Bitte Pfad eingeben","...","C:\Alles\")  
Pfad5_7_Anhaengsel = "5_7_LinienPlaene"  
Pfad5_8_Anhaengsel = "5_8_Energie_Abwasser_Absperrplan"  
SucheStrA = "5_7_"  
SucheStrB = "5_8_"  



set fs = createobject("Scripting.FileSystemObject")  
IPfade2 = 1
IPfade3 = 1

Listordner Ordner
Sub ListOrdner(ordner)
	Set ordner = fs.getfolder(ordner)

	For Each file In ordner.files
		'Pfadangabe =File.path  
		
	next
	

	For Each Unterordner In Ordner.subfolders
		Pfadangabe = unterordner.path

		PfadNeu = split(Pfadangabe , "\")  

		If Ubound(PfadNeu) = 3 then
			Temp1 = InStr(Pfadangabe,SucheStrA)
			If Not Temp1 = 0 then 
				PfadBisEbeneDrei(IPfade3) = Pfadangabe
				IPfade3 = IPfade3 + 1
			End If
			
			Temp2 = InStr(Pfadangabe,SucheStrB)
			If Not Temp2 = 0 then 
				PfadBisEbeneDrei(IPfade3) = Pfadangabe
				IPfade3 = IPfade3 + 1
			End If
'50:  
			Temp = PfadNeu(0) & "\" &  PfadNeu(1) & "\" & PfadNeu(2) & "\"		  
			If Not Temp = PfadBisEbeneZwei(IPfade2 -1) Then
				PfadBisEbeneZwei(IPfade2) = TemP
				IPfade2 = IPfade2 + 1
			End If
				
		End if
		
		Listordner unterordner
	Next
	
End Sub

For m = 0 to UBound(PfadBisEbeneDrei)
	If not PfadBisEbeneDrei(m) = "" Then  
		PfadKomplett(m,0) = PfadBisEbeneDrei(m)
		PfadKomplett(m,1) = PfadBisEbeneDrei(m + 1)
		Set Ordner = fs.GetFolder(PfadKomplett(m,0))
		For Each file In ordner.files
		Pfadangabe = File.path
		PfadNeu = split(Pfadangabe , "\")  
		DateiName = PfadNeu(Ubound(PfadNeu))			
			WScript.Echo "Verschiebe Datei:" & PfadKomplett(m,0) & "\"  & DateiName &  "  nach: " & PfadKomplett(m,1) & "\"  & DateiName  
			'FS.MoveFile PfadKomplett(m,0) & "\"   & DateiName , PfadKomplett(m,1) & "\"  & DateiName  
		Next
		Pfadangabe = PfadBisEbeneDrei(m)
		PfadNeu = split(Pfadangabe , "\")  
			PfadKomplettNeu = PfadNeu(0) & "\" & PfadNeu(1) & "\" & PfadNeu(2)& "\" & Pfad5_7_Anhaengsel  
			WScript.Echo "Benenne Pfad: " & PfadKomplett(m,0) & "  um nach: " & PfadKomplettNeu  
			'FS.MoveFolder PfadKomplett(m,0) , PfadKomplettNeu  
			PfadKomplettNeu = PfadNeu(0) & "\" & PfadNeu(1) & "\" & PfadNeu(2)& "\" & Pfad5_8_Anhaengsel  
			WScript.Echo "Benenne Pfad: " & PfadKomplett(m,1) & "  um nach: " & PfadKomplettNeu  
			'FS.MoveFolder PfadKomplett(m,1) , PfadKomplettNeu  
		m = m + 1
		End If
Next


For l = 0 to UBound(PfadBisEbeneZwei)
	If not PfadBisEbeneZwei(l) = "" Then  
		NeuOrdner5_9_Neu = PfadBisEbeneZwei(l) & "5_9_Uebersichtsplan"   
		If Not fs.FolderExists(NeuOrdner5_9_Neu) then
			WScript.Echo "Erstelle Neuen Ordner:" & NeuOrdner5_9_Neu  
			'NeuOrdner5_9_Neu = fs.CreateFolder(NeuOrdner5_9_Neu)  
		End if
	End If
Next



WScript.Echo "Fertig"  

Echo %Date% >Log.txt
CScript Josken.vbs >>Log.txt

On error resume next
			WScript.Echo "Verschiebe Datei:" & PfadKomplett(m,0) & "\"  & DateiName &  "  nach: " & PfadKomplett(m,1) & "\"  & DateiName  
			FS.MoveFile PfadKomplett(m,0) & "\"   & DateiName , PfadKomplett(m,1) & "\"  & DateiName  
		
		If Err.Number <> 0 Then 'Fuer den Fall, dass Zieldatei schon exisitiert!  
  			Wscript.Echo "******************Fehler****************** Start "  
			Wscript.Echo "Datei: " & Dateiname & " existiert in " & PfadKomplett(m,1) & " schon."   
  			Err.Clear
			Set objFileCheck = fs.GetFile(PfadKomplett(m,1) & "\"  & DateiName)  
			Wscript.Echo "Loesche: " & PfadKomplett(m,1) & "\"  & DateiName  
			objFileCheck.Delete ()
			WScript.Echo "Verschiebe Datei:" & PfadKomplett(m,0) & "\"  & DateiName &  "  nach: " & PfadKomplett(m,1) & "\"  & DateiName  
			FS.MoveFile PfadKomplett(m,0) & "\"   & DateiName , PfadKomplett(m,1) & "\"  & DateiName  
			Wscript.Echo "******************Fehler****************** Ende "  
 		End If