Office: (Office 2010) Text via VBA in Textdatei (txt) suchen und ersetzen

Klaus01 · 16. Mai 2017

Hallo Leute

Ich habe hier ein kleines(!) Problem mit mehreren Txt-Dateien.

In einem Ordner (fix) sind mehrere Text-Dateien (>150) gespeichert. Diese wurden fehlerhalft erstellt.

Sowohl der Dateiname als auch ein Teil des Inhaltes.
Dateiname IST „F050.o8.018_21_4_2017_15_5_25“ – wobei hier das „o8“ falsch ist.
Dies sollte in SOLL „F050.08.018_21_4_2017_15_5_25 geändert werden.

Das gleiche im Inhalt
Inhalt IST „F050.o8.018“ – wobei auch hier das „o8“ falsch ist.
Dies sollte in SOLL „F050.08.018 geändert werden.

Nun habe ich ein Programm gefunden das dies genauso macht – nur mit einzigen Mango, dass ich die „fspenTextFile“-Angabe händisch ändern müsste.
Code:

Option Explicit
Sub tauschen()
'Test.vbs

Dim fso, f, text
Const ForInput = 1, ForOutput = 2

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fspenTextFile("d:/##/F050.o8.018_20_4_2017_17_5_14.txt", ForInput)
text = f.ReadAll
text = Replace(text, "o8", "08")
f.Close

Set f = fspenTextFile("d:/##/F050.08.018_20_4_2017_17_5_14.txt", ForOutput, True)
f.Write (text)
f.Close
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kurzum, wie müsste das Makro in einer Schleife aussehen um alle Txt-Dateien zu ändern?

Ich danke Euch schon mal im Voraus für Eure Hilfe.

Gruss Klaus

:)

User · 18. Mai 2017

Hallo Klaus *wink.gif*

Probier mal!

Gruss Poltergeist

Code:

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim fso, f, text
DateiName = Dir("d:/##/" & "*.txt") 'Pfad anpassen
Do While DateiName ""
Const ForInput = 1, ForOutput = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fspenTextFile(DateiName, ForInput)
text = f.ReadAll
text = Replace(text, "o8", "08")
f.Close
Set f = fspenTextFile(DateiName, ForOutput, True)
f.Write (text)
f.Close
End Sub
DateiName = Dir
Loop
Call EventsOn
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Fennek11 · 18. Mai 2017

Hallo,

so ganz freihändig und ungetestet:

PHP:

Sub aendern() iPath = "C:temp" '<<<<<< anpassen iFile = dir(iPath & "F050*.txt") do while len(iFile) if instr(iFile, ".o8.") > 0 than iFile_neu = Replace(iFile, "o8", "08") 'dann wie das gezeigte Script, aber mit iFile bei "open" und iFile_neu bei "save" end if iFile = dir end sub loop

Klaus01 · 18. Mai 2017

Hallo zusammen,

vorerst mal ein dickes Dankeschön für die schnelle Bearbeitung.
Nur ab ich trotzdem noch einige Probleme damit.

@Poltergeist
Dein Code bleibt bei Code:

Set f = fspenTextFile(DateiName, ForInput)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mit der Fehlermeldung 53 - "Datei nicht gefunden" stehen.

Die Variable "DateiName" und "ForInput" sind befüllt mit dem Dateinamen bzw. mit 1.

An was kann dies noch liegen?

@Fennek11
Bei Deinem Code komme ich nicht klar. Könntest Du mir den Code so anzeigen wie es du gemeint hast.

An Euch bei vielen Dank für´s helfen.

Gruss Klaus

Klaus01 · 20. Mai 2017

Hallo zusammen,

könnte mir jemand eine Schleife um meinen ersten Code erstellen? Damit wäre das Problem erledigt.

Im voraus vielen Dank

Gruss Klaus

User · 20. Mai 2017

Hallo Klaus *wink.gif*

Habe es nun auch getestet *Smilie

Gruß Poltergeist *biggrin.gif*

Code:

Sub DateienLesen()
Call EventsOff
Dim DateiName As String, Dpfad As String
Dim fso As Object, f As Object
Dpfad = "J:/Temp/"
DateiName = Dir(Dpfad & "*.txt")
Do While DateiName ""
Const ForInput = 1, ForOutput = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fspenTextFile(Dpfad & DateiName, ForInput)
text = f.ReadAll
text = Replace(text, "o8", "08")
f.Close
Set f = fspenTextFile(Dpfad & DateiName, ForOutput, True)
f.Write (text)
f.Close
DateiName = Dir
Loop
Call EventsOn
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klaus01 · 20. Mai 2017

Hallo Poltergeist,

funktioniert prima.
Nun muss Du mir noch sagen/zeigen wie ich den Dateien-Namen, der auch falsch angelegt wurde, ändere. Dann wäre es perfekt *wink.gif*

Gruss Klaus

Office: (Office 2010) Text via VBA in Textdatei (txt) suchen und ersetzen

Text via VBA in Textdatei (txt) suchen und ersetzen

Text via VBA in Textdatei (txt) suchen und ersetzen

Text via VBA in Textdatei (txt) suchen und ersetzen

Text via VBA in Textdatei (txt) suchen und ersetzen - Similar Threads - Text via VBA

Leerzeichen vor linksbündigem Text in Zellen

Suchen " " oder "-" in Text

Textteile aus Zelle mit mehreren Absätzen

Summewenns erkennt text aus der formel nicht

Häufigste Wert/Text aus einer Spalte ermitteln ohne leere oder 0

DATEDIF Ergebnis

Letzten Wert(Text!) einer Zeile ausgeben