Sonderzeichen aus Datei- u. Ordnernamen entfernen bzw. ersetzen per bat o. vbs

on error resume next

Dim FilterStr , PfadStr
Dim PfadStrNeu, DateiNameNeu
Dim Alt, Neu
Dim MyText()
Dim  X , ZX
Dim ZMAx

FilterStr = "*.*"  
X = 0
ZMax = 0
LogPath = "D:\Replace.txt"  
FN = ""  
FNR = ""  
vbTextCompare = 1


Set objWord = CreateObject("Word.Application")  
Set FSO = CreateObject("Scripting.FileSystemObject")  

Set MyLogFile = FSO.CreateTextFile(LogPath, TRUE)
MyLogFile.Close



PfadStr = inputbox("Bitte den kompletten Pfad zu dem zu durchsuchenden Ordner eingeben.","Pfadangabe...","D:\1\")  
PfadStrNeu = PfadStr & "ReplacedFiles\"  

FSO.CreateFolder(PfadStrNeu)

Alt = inputbox("Bitte die zu ersetzende Zeichenkette eingeben...", "Alte Zeichenkette...", "ä")   
Neu = inputbox("Bitte die neue Zeichenkette eingeben...", "Neue Zeichenkette...", "ae")   

msgbox "Befehl wird ausgeführt! Bitte warten!",,"Mit Word...."  

objWord.FileSearch.FileName = FilterStr
objWord.FileSearch.LookIn = PfadStr
objWord.FileSearch.SearchSubfolders = False
objWord.FileSearch.Execute


objWord.Visible = False

Set MyLogFile = FSO.OpenTextFile(LogPath, 8)
MyLogFile.WriteLine (Time & "|Beginne Script: 'Replace_Strings_in_gesamten_Ordner.vbs'")  

For Each objFile in objWord.FileSearch.FoundFiles	
	
	MyLogFile.WriteLine (Time & "|  Oeffne Datei: " & ObjFile)  

'Jetzt holen wir uns nur den Dateinamen raus	  
	FN = ""  
	FNR = ""  
	IFN = ""  
	IFNR = ""  
	for IFN = len(Objfile) to 0 Step -1
		FNTemp = mid (Objfile,IFN,1)
			If Not FNTemp = "\" then FN = FN & FNTemp  
			If FNTemp = "\" Then IFN = 0  
	next

'Hier wieder richtig rum drehen ;-)  
	for IFNR = len(FN) to 1 Step -1
		FNTempR = mid (FN,IFNR,1)
			FNR = FNR & FNTempR
	next

	ZMAx = 0
	Set MyDatei = FSO.OpenTextFile(objFile, 1)
	Do Until MyDatei.AtEndOfStream 
		TempText = MyDatei.ReadLine
		ZMAx = Zmax + 1 
	Loop
	MyDatei.close	
	
	ReDim MyText(ZMax)

	Set MyDatei = FSO.OpenTextFile(objFile, 1)
	Do Until MyDatei.AtEndOfStream 

		MyText(X) = MyDatei.ReadLine
	
		Tsuki = InStr(1,MyText(X), ALT, vbTextCompare)
	
		ZX = X
			If ZX < 10  then ZX = "0" & ZX  
			If ZX < 100 then ZX = "0" & ZX  

		IF Tsuki > 0 Then
			MyLogFile.WriteLine (Time & "|     Zeile " & ZX & ": [" & ALT & "] ersetzt durch [" & Neu & "]")  
		End If
		
		MyText(X) = Replace(MyText(X), Alt, Neu) 

		X = X + 1  

	Loop
	MyDatei.close
	

	PfadNeu = PfadStrNeu & FNR 

	MyLogFile.WriteLine (Time & "|Schreibe Datei: " & PfadNeu)  

	Set MyDatei1 = FSO.CreateTextFile(PfadNeu, TRUE)
	MyDatei1.Close
	
	Set MyDatei1 = FSO.OpenTextFile(PfadNeu, 8)
	for I = 0 to (X - 1)
		MyDatei1.WriteLine (MyText(I))
	next
	MyDatei1.Close
	
	X = 0
Next

MyLogFile.WriteLine (Time & "| Beende Script: 'Replace_Strings_in_gesamten_Ordner.vbs'")  
MyLogFile.Close

WScript.Echo Time & "| Script beendet."  

objword.quit

Set objword = nothing
Set MyDatei = nothing
Set FSO = nothing