24.11.2009, aktualisiert um 15:44:48 Uhr

19674

Sonderzeichen in Ordner und Dateinamen mit VBScript ersetzen. (bastlas script)

gelöstFrage VB for Applications Entwicklung

Hallo Zusammen,

ich habe folgendes mit der Suchfunktion gefunden:

Mit VB Script Sonderzeichen entfernen.
Mit VB Script Sonderzeichen entfernen die 2.

Das Skript funktioniert soweit auch wunderbar. Danke an bastla für dieses Skript.

Mein Problem ist nun, das bei mir wirklich ALLE Sonderzeichen die in folgender ASCII Tabelle stehen durch "_" ersetz werden sollen.

http://www.torsten-horn.de/techdocs/ascii.htm

Wie kann ich die "SonderzeichenErsetzung.txt" so erweitern, dass diese Zeichen nun auch ersetz werden?
Ich habe schon einiges probiert, bin aber nicht so ganz fit mit den verschiedenen Codes.

Vielen Dank,
baeks

*EDIT*

Ich habe noch einen Script von bastla gefunden. Die Version mit der Liste von Zeichen die zugelassen werden scheint mir sinnvoller als eine Liste von Zeichen die nicht zugelassen werden, da sie viel kürzer ist. Ist es möglich auch Ordner damit umzubenennen?

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 130111

Url: https://administrator.de/forum/sonderzeichen-in-ordner-und-dateinamen-mit-vbscript-ersetzen-bastlas-script-130111.html

Ausgedruckt am: 30.04.2025 um 19:04 Uhr

15 Kommentare

Neuester Kommentar

Hallo baeks1986!

Mit Deinem Problem habe ich mich noch nicht beschäftigt, aber die Scancodes auf Deiner Website sind teilweise nicht korrekt. Hier eine Excel-Tabelle mit den kompletten Scancodes der erweiterten MFII-Tastatur:

f11c91034327d4ed12d7d81f3604bb78-scancodes

Gruß Dieter

Danke für den Hinweis, aber ich hatte die Tabelle mit Asc() und Chr() stichprobenartig geprüft und habe keine fehler gefunden, welche sollen denn falsch sein?

Gruss
baeks

Hallo braeks1986!

habe nicht alle durchgesehen, aber zumindest diese beiden Scancodes stimmen nicht:
2B - "<" falsch = 56h
29 - "#" falsch = 2Bh

Fehlt z.B.:
Space = 39h

Gruß Dieter

Hallo baeks1986!

Im Prinzip, muss nur die Ersetzen-Liste mit den Sonderzeichen entsprechend erweitert werden. Sollen z.B. die Zeichen "§$#" durch "_" ersetzt werden, dann müsstest Du nur "_,§,$,#" in einer neuen Zeile anfügen. Ansonsten wäre es hilfreich, wenn Du erstmal klar definierst, was Deiner Meinung nach alles zu den Sonderzeichen zählt und/oder welche Zeichen zugelassen sind und ob Htm-Pseudos auch berücksicht werden müssen und und und???

Gruß Dieter

Sonderzeichen sind bei mir in dem Fall alle Zeichen, die nicht AaBb [...]Zz und nicht 0123456789 sind. Genau das meinte ich, wie kann ich diese Tabelle erweitern, ich habe den Aufbau der ersetzen Tabelle noch nicht ganz verstanden.

Hallo baeks1986!

Die Ersetzen-Funktion und Ersetzentabelle ist so aufgebaut, dass der Zeichen-Teil vor dem ersten Komma, alle nachfolgenden durch Kommagetrennte Zeichen ersetzt. Das können 1 Zeichen oder Zeichenfolgen wie bei den Htm-Pseudos sein.

Beispiel: _,§,$,ä,ö,ü,text

"§" wird ersetzt durch "_"
"$" wird ersetzt durch "_"
"ä" wird ersetzt durch "_"
"ö" wird ersetzt durch "_"
"ü" wird ersetzt durch "_"
"text" wird ersetzt durch "_"

Und was ist mit den Htm-Pseudos z.b. ü oder %C0 und Umlauten. Hast Du Htm-Pseudos in Deinen Datei- und Ordnernamen?

Wenn nicht, würde man keine Ersetzen-Tabelle benötigen und das Ganze mit einer If- oder Case-Anweisungen lösen.

Gruß Dieter

Hi Dieter,

danke schonmal für deine Hilfe, in meinen Dateinamen kommen keine HTM-Pseudos vor. Wie würde die Case-Anweisung dann aussehen?

Select Case Zeichen
Case "$"
?????
Case "%"
?????
End Select

Und die ???? sind dann die Ersetzen funktion?

Ich glaube ich mach das doch mit der Tabelle, scheint mir einfacher und ist dann wohl auch für dich/euch einfacher mir zu erklären.

Vielen Dank schonmal,
Max

Hallo baeks1986!

Eigentlich hatte ich an so was gedacht, aber leider geht das nur in VBA. In VBS gibt es keinen To-Operator:

Select Case c
    Case "A" To "Z"  
    Case "a" To "z"  
    Case "0" To "9"  
    Case Else
         'Tue Was  
End Select

In VBS dann entweder so (das gleiche in Grün):

Function ReplaceSpecialChar(ByRef Text)
    
    s = Text
    
    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        If c >= "0" And c <= "9" Then	'Wenn True Do Nothing  
        ElseIf c >= "A" And c <= "Z" Then	'Wenn True Do Nothing  
        ElseIf c >= "a" And c <= "z" Then	'Wenn True Do Nothing  
        Else
             s = Replace(s, c, "_")		'Wenn False Do Replace  
        End If
    Next
    
    ReplaceSpecialChar = s
End Function

oder etwas aufwendiger so:

Function ReplaceSpecialChar(ByRef Text)
    
    s = Text
    
    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        Select Case c
            Case "0","1","2","3","4","5","6","7","8","9"  
            Case "A","B","C","D","E","F","G","H","I","J","K","L","M", _  
                 "N","O","P","Q","R","S","T","U","V","W","X","Y","Z"  
            Case "a","b","c","d","e","f","g","h","i","j","k","l","m", _  
                 "n","o","p","q","r","s","t","u","v","w","x","y","z"  
            Case Else
                s = Replace(s, c, "_")  
        End Select
    Next
    
    ReplaceSpecialChar = s
End Function

Oder zwecks Wartungsfreundlichkeit doch die Sonderzeichen.Txt anpassen. Du hast die Freie Auswahl

Gruß Dieter

Vielen Dank für deinen freundlichen Support. Damit sollte das Problem behoben sein.

Danke, Danke, Danke...

Hallo Max!

Gern geschehen

Gruß Dieter

Ich habe das Script jetzt auf meine Bedürfnisse angepasst. Ich poste es einfach mal:

'ReplaceSpecialSings,vbs  

sSonder = InputBox("Please define the SpecialSigns.txt:","ReplaceSpecialSigns","PFAD")  
sFolder = InputBox("Please define the Folder where everything should be replaced:","ReplaceSpecialSigns","PFAD")  

Set oFSO = CreateObject("Scripting.FileSystemObject")  
Set oSonder = oFSO.OpenTextFile(sSonder, 1)

If Not oSonder.AtEndOfStream Then 
     aSonder = Split(oSonder.ReadAll, vbCrLF)
Else
     MsgBox ("Sonderzeichendatei " & sSonder & " enthält keine Daten!")  
End If
oSonder.Close

ProcessFolder(oFSO.GetFolder(sFolder))
Sub ProcessFolder(oFolder)
sNameOld = oFolder.Name

sNameNew = ReplaceSpecialChars(sNameOld)
If Not oFSO.FolderExists(oFolder.ParentFolder & "\" & sNameNew) Then  
    oFolder.Name = sNameNew
Else
    If sNameOld <> sNameNew Then oProtokoll.WriteLine oFolder.Path
End If

For Each oFile In oFolder.Files
    sNameOld = Left(oFile.Name, InStrRev(oFile.Name, ".") - 1)  
    sType = Mid(oFile.Name, InStrRev(oFile.Name, "."))  

    sNameNew = ReplaceSpecialChars(sNameOld)
    If Not oFSO.FileExists(oFile.ParentFolder & "\" & sNameNew & sType) Then  
        oFile.Name = sNameNew & sType
    End If
    
    Next

For Each oSubFolder In oFolder.SubFolders
    ProcessFolder(oSubFolder)
Next
End Sub

Function ReplaceSpecialChars(sOld)
sTemp = sOld
For Each sLine In aSonder
    aChars = Split(sLine, ",")  
    For i = 1 To UBound(aChars)
        sTemp = Replace(sTemp, aChars(i), aChars(0))
    Next
Next
ReplaceSpecialChars = sTemp
End Function
MsgBox "Finished...",64,"...---'''COMPLETED'''---..."  

zusätzlich benötigt man die Datei mit den Sonderzeichen die ersetz werden sollen.

Hallo baeks1986!

Schön, dass Du den Code nochmal komplett gepostet hast

Die Zeile 12 könntest Du allerdings noch entfernen, da die gleiche Anweisung in Zeile 15 steht und die Datei unabhängig von True/False schließt

Gruß Dieter

Oh, ja danke. Wird gemacht...

Wenn du Lust und Zeit hast würde ich gerne weiter an dem Script arbeiten. Ich soll diesen Script jetzt noch eweitern auf:

1. die Datei und Ordnernamen dürfen nicht länger als 240 Zeichen sein. (Habs schon geschafft das ende abzuschneiden, aber dann ist die Endung ja immer mit weg, und das will ja keiner also müsste ich das irgendwie von vorne abschneiden.

2. Sollen jetzt alle Files die größer als 25 MB sind in einen gesonderten Ordner geschoben werden, der aber die selben Ordnernamen beinhaltet wie die wo er vorher drin war...Ich weis, ist schlecht erklärt aber ich versuche es mal anhand eines Beispiels.

Ordner1
|_ Ordner2
|_Ordner3
|_hier liegen die 25MB+ Files
|_außerdem liegen hier noch enttliche andere Files

Jetzt soll die 25MB+ Datei so verschoben werden:

Ordner1
|_ Ordner2
|_Ordner3
|_ettliche andere Files aber KEINE File 25MB+

KopieOrdner1
|_KopieOrdner2
|_KopieOrdner3
|_hier liegen jetzt die 25MB+ Files aber KEINE anderen

Ist das so verständlich?

Für 1. habe ich gedacht man könnte das irgéndwie mit InStr() oder Len() Pos() Left() oder so lösen, bin aber bis jetzt nicht auf den richtigen Pfad gekommen.

Für 2. habe ich an ein Select Case gedacht mit GetFile.Size aber meine großes Problem ist dann die Ordner so wie oben angegeben zu erstellen.

Hast du/ihr da eine Idee?

Gruss,
Max

Hallo baeks1986!

In Deinem Code Zeile 27 hast Du ja bereits eine Zerlegung des Dateinamens. Z.B. Datei = MeineDatei.Xyz

For Each oFile In oFolder.Files
    sNameOld = Left(oFile.Name, InStrRev(oFile.Name, ".") - 1)    '= MeineDatei  
    sType = Mid(oFile.Name, InStrRev(oFile.Name, "."))            '= Xyz  
Next

Das kann man entsprechend erweitern z.B. Datei-Pfad = X:\Test1\Test2\Datei.Xyz

For Each oFile In oFolder.Files
    sSize = oFile.Size                               '= Size in Byte  
    sPath = oFile.Path                               '= X:\Test1\Test2\Datei.Xyz  
    sFolder1 = oFolder.Path                          '= X:\Test1\Test2  
    sFolder2 = oFolder.ParentFolder                  '= X:\Test1  
    sFolder3 = oFolder.Name                          '= Test2  
    sFile = oFile.Name                               '= Datei.Xyz  
    sName = oFso.GetBaseName(sPath)                  '= Datei  
    sType = oFso.GetExtensionName(sPath)             '= Xyz  

   'Weitere Funktionen  
    nFolder = sFolder2 & "\Kopie" & sFolder3         '= X:\Test1\KopieTest2  
    nPath = oFso.BuildPath(nFolder, sFile)           '= X:\Test1\KopieTest2\Datei.Xyz  
    
    If sSize > MaxSize Then                          'Test Size  
        If Not oFso.FolderExists(nFolder) Then       'Test Folder Exists  
            oFso.CreateFolder (nFolder)              'Create Kopie-Folder  
        End If
        oFso.MoveFile sPath, nPath                   'Move File  
    End If
Next

Das sollte Dir weiterhelfen

Gruß Dieter

Ja das hilft auf jedenfall

Mein Problem ist nur, dass die Pfade ALLE dynamisch sind, dieser Script soll bei übernahme von anderen Firmen und eingliederung in unser Netzwerk laufen...

gelöstFrage VB for Applications Entwicklung

Heiß diskutiert