noob-x
Sep 30, 2013, updated at 14:58:01 (UTC)
view5382
view6
0
Goto Top

.txt datei auslesen, Text ausschneiden und in neue Datei speichern.

GermansolvedQuestionVB for ApplicationsDevelopment
Hallo,

bitte um Eure Hilfe.

Ich möchte aus einer .txt Datei bestimmte Bereiche ausschneiden und in mehrere neue Dateien abspeichern.

Es handelt sich um einen Druckstrom aus einem Programm

.txt Datei ist folgendermaßen aufgebaut.

<-XxX

text
text
text

<-YyY <-XxX

text
text
text
Zwischensumme

<-YyY <-XxX

text
text
text

<-YyY <-XxX

nun sollte alles von <-XxX bis <-YyY ausgeschnitten und in einer neuen txt Datei abgespeichert werden,
ausser es steht Zwischensumme in dem Bereich, dann sollte <-YyY ignoriert werden und erst beim nächsten
oder übernächsten <-YyY ausgeschnitten werden.
Und das so oft bis die Quelldatei leer ist, welche dann auch gelöscht werden kann.

Am Anfang der Ziel Datei sollte jeweils AaA und am Ende ZzZ stehen.

Ist für mich ein großes ?, aber vermutlich für Euch Spezialisten kein Problem sowas zu machen, ich hab echt keine Ahnung wo ich anfangen oder suchen soll.
Batch oder VBS bin für alle Lösungsvorschläge offen.

Danke im Voraus

Andy
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 218177

Url: https://administrator.de/contentid/218177

Printed on: April 18, 2024 at 06:04 o'clock

6 Comments
Latest comment
Goto Top
Member: colinardo
colinardo Sep 30, 2013, updated at Oct 01, 2013 at 06:13:39 (UTC)
Goto Top
Hallo Andy,
versuchs mal mit folgendem VBS-Script und überprüfe damit ob ich dich richtig verstanden habe:
(Zeile 1 den Pfad zu deiner Textdatei eintragen, und in Zeile2 den Pfad wo die neuen Dateien erstellt werden sollen)
FILEPATH = "C:\test.txt"  
FILEPATH_NEWFILES = "C:\Ausgabe"  
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objText = objFSO.OpenTextFile(FILEPATH,1)
strText = objText.ReadAll
objText.Close()
counter = 1
Set myRegExp = CreateObject("vbscript.regexp")  
myRegExp.IgnoreCase = False
myRegExp.Global = True
myRegExp.Pattern = "((<-XxX[\s\S]*?Zwischensumme[\s\S]*?<-YyY[\s\S]*?<-YyY)|(<-XxX[\s\S]*?<-YyY))"  
Set myMatches = myRegExp.Execute(strText)
If myMatches.Count >= 1 Then
For Each myMatch In myMatches
	If myMatch.SubMatches.Count >= 1 Then
		Set f = objFSO.OpenTextFile(FILEPATH_NEWFILES & "\test_" & counter & ".txt",2,True)  
		strNewContent = "AaA" & vbNewLine & myMatch.SubMatches(0) & vbNewLine & "ZzZ"  
		f.Write(strNewContent)
		f.Close
		counter = counter + 1
	End If
Next
End If
'Nächste Zeile auskommentieren zum löschen der Quell-Datei  
'objFSO.DeleteFile(FILEPATH)  
Set objFSO = Nothing

getestet habe ich mit folgendem Text:

<-XxX

text
text
text
......

<-YyY <-XxX

text
text
text
Zwischensumme
......

<-YyY <-XxX

text

text
text
......

<-YyY <-XxX

text
Zwischensumme
text
text
......
<-YyY <-XxX

text
text
text
......
<-YyY

laut deiner Beschreibung sollte das Script aus diesem Text dann zwei Dateien mit folgendem Inhalt machen:

Datei 1
AaA
<-XxX

text
text
text
......

<-YyY <-XxX

text
text
text
Zwischensumme
......

<-YyY <-XxX

text

text
text
......

<-YyY
ZzZ
Datei 2
AaA
<-XxX

text
Zwischensumme
text
text
......
<-YyY <-XxX

text
text
text
......
<-YyY
ZzZ
wenn ich dich richtig verstanden habe ...
Das löschen der Quelldatei habe ich noch nicht aktiviert(Zeile 25), damit du testen kannst.

Grüße Uwe
heart1
Member: noob-x
noob-x Oct 01, 2013 at 07:03:57 (UTC)
Goto Top
Hi,

Danke für die schnelle Antwort, läuft aber noch nicht so wie es sein soll.

der Bereich zwischen <-XxX und <-YyY stellt ein Blatt dar, falls nun die Zwischensumme in diesem Bereich steht
ist das ein 2. Blatt welches zum 1. dazugehört und mit in die neue Datei übernommen werden soll, können aber theoretisch bis zu 100 und mehr Seiten sein die zusammengehören.

Falls keine Zwischensumme in dem Bereich zu finden ist handelt es sich um eine einseitige Rechnung.

Das ist nicht immer gleich. Mal sinds alles einseitige , mal sind ein paar mehrseitige dabei.

Das Skript von Dir funktioniert aber im großen und ganzen nur dass die Trennung noch nicht ganz passt, echt toll beim ersten Versuch schon so ein gutes Ergebnis
zu erzielen "RESPEKT" und vielen Dank nochmal.

Wäre super wenn Du mir hier mit dem Feinschliff noch etwas helfen könntest. Es können auch mehr Dateien in dem Verzeichnis sein face-smile

LG

Andy
Member: colinardo
colinardo Oct 01, 2013 updated at 09:07:58 (UTC)
Goto Top
Dein Wunsch sei mir Befehl face-smile
In Zeile 6 kannst du die Dateierweiterungen angeben, die im Quell-Ordner durchsucht werden soll - dies können auch mehrere sein Bsp. arrFileExtensions = Array("txt","log")
'Pfad in dem sich die Stream-Files befinden  
FILEPATH = "C:\quelle"  
'Ausgabepfad für die einzelnen Rechnungen  
OUTPUTPATH = "C:\Ziel"  
'Erweiterungen der Dateien die durchsucht werden sollen  
arrFileExtensions = Array("txt")  

Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set myRegExp = CreateObject("vbscript.regexp")  
myRegExp.Global = True
For Each file In objFSO.GetFolder(FILEPATH).Files
	For i = 0 To UBound(arrFileExtensions)
		If LCase(arrFileExtensions(i)) = LCase(objFSO.GetExtensionName(file.Path)) Then
			Set objText = objFSO.OpenTextFile(file.Path,1)
			strText = objText.ReadAll
			objText.Close()
			myRegExp.IgnoreCase = False
			myRegExp.Pattern = "(<-XxX[\s\S]*?<-YyY)"  
			Set myMatches = myRegExp.Execute(strText)
			If myMatches.Count >= 1 Then
				counter = 1
				strNewContent = ""  
				For Each myMatch In myMatches
					If myMatch.SubMatches.Count >= 1 Then
						myRegExp.IgnoreCase = True
						myRegExp.Pattern = "Zwischensumme"  
						If myRegExp.Test(myMatch.SubMatches(0)) Then
							strNewContent = strNewContent & myMatch.SubMatches(0)
						Else
							strNewContent = strNewContent & myMatch.SubMatches(0)
							newFilePath = OUTPUTPATH & "\" & objFSO.GetBaseName(file.Path) & "_Rechnung_" & counter & "." & objFSO.GetExtensionName(file.Path)  
							Set f = objFSO.OpenTextFile(newFilePath,2,True)	
							strNewContent = "AaA" & vbNewLine & strNewContent & vbNewLine & "ZzZ"  
							f.Write(strNewContent)
							f.Close
							strNewContent = ""  
							counter = counter + 1	
						End If
					End If
				Next
			End If
			'Nächste Zeile auskommentieren zum löschen der Quell-Datei  
			'objFSO.DeleteFile(file.Path)  
			Exit For
		End If
	Next
Next
wscript.echo "Fertig"  
Set objFSO = Nothing
Set myRegExp = Nothing

Grüße Uwe
heart1
Member: noob-x
noob-x Oct 01, 2013 at 11:42:47 (UTC)
Goto Top
Vielen Vielen Dank,

da spare ich mir in Zukunft Viel Zeit.

LG

Andy
Member: noob-x
noob-x Oct 02, 2013 at 12:37:59 (UTC)
Goto Top
Hi,

ich nochmal face-smile

was muss ich jetzt ändern wenn ich die Datei nicht löschen sondern in einem Ordner archivieren möchte ?

habs mit objFSO.MoveFile anstatt objFSO.DeleteFile versucht und den Zielordner eingegeben aber da bekomme ich immer ne Fehlermeldung.

Grüße

Andy
Member: colinardo
colinardo Oct 02, 2013 at 12:58:06 (UTC)
Goto Top
Zitat von @noob-x:
was muss ich jetzt ändern wenn ich die Datei nicht löschen sondern in einem Ordner archivieren möchte ?

habs mit objFSO.MoveFile anstatt objFSO.DeleteFile versucht und den Zielordner eingegeben aber da bekomme ich immer ne
Fehlermeldung.
da hat du wahrscheinlich den Zielordner nicht mit einem Backslash am Ende angegeben, so sollte die Zeile aussehen:
objFSO.MoveFile file.Path,"c:\Backup\"
Grüße Uwe
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 CommentAsifHeywoodMengisi Liburan dengan Kemenangan Menggiurkan: Kenikmatan Bermain Slot Holiday RAsifHeywood