AW: Hilfe:Sonderzeichen ersetzen in vielen Textdateien
22.08.2011 10:24:42
Tino
Hallo,
kannst mal testen.
Wie immer zuerst eine Sicherung Deiner Textdateien anlegen,
sollte etwas schief gehen kannst Du diese wiederherstellen!
Option Explicit
Sub Beispiel()
Dim strPath$, strDir$, sLines$, UmbruchZeichen$
Dim ArrayFile(), ArrUmlaute
Dim n&, nn&
Dim F%
'Auslistung Zeichen Reihenfolge beachten
'Suchzeichen, ersetze durch, Suchzeichen, ersetze durch usw...
ArrUmlaute = Array("Ã", "Ü", "ü", "ü", "ö", "ö", "ä", "ä", "Ã", "ß")
'evtl. Pfad anpassen wo sich die Textdateien befinden
'hier sind diese auch diese Excel-Datei liegt
strPath = ThisWorkbook.Path
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
'*.txt- Dateien im Ordner suchen u. sammeln
strDir = Dir$(strPath & "*.txt", vbNormal)
Do While strDir <> ""
Redim Preserve ArrayFile(n)
ArrayFile(n) = strPath & strDir
n = n + 1
strDir = Dir$()
Loop
If n > 0 Then
UmbruchZeichen$ = Chr(8) & Chr(9) & Chr(10) & Chr(13)
For n = Lbound(ArrayFile) To Ubound(ArrayFile)
'Datei einlesen
F = FreeFile
Open ArrayFile(n) For Binary As #F
sLines = Space$(LOF(F))
Get #F, , sLines
Close
'Ersetze Zeichen im String
For nn = Lbound(ArrUmlaute) To Ubound(ArrUmlaute) Step 2
sLines = Replace(sLines, ArrUmlaute(nn), ArrUmlaute(nn + 1))
Next nn
'nicht benötigte Umbruchzeichen am Ende löschen
Do While InStr(UmbruchZeichen, Right$(sLines, 1)) > 0
sLines = Left$(sLines, Len(sLines) - 1)
Loop
'String zurückschreiben
Open ArrayFile(n) For Output As #F
Print #F, sLines
Close #F
Next n
End If
End Sub
Gruß Tino