====== [VBA] Zeilenweises Prüfen einer Datei mit RegExp ======
//Eine Datei mit RegeExp zeilenweise durchsuchen und die Resultate verwerten//
===== Intro =====
RegExp-Erfahrung ist eine Voraussetzung für dieses Tutorial. Ich gehe nicht weiter auf die Regulären Ausdrücke und die Grundfunktionalität von VBScript.RegExp ein.
Ich bekomme immer wieder Text-Dateien, die irgend ein Report aus einem System darstellen. Leider sind diese dann nicht im csv- oder einem anderen Sinnvollen Format vorhanden. Also muss man mit einem Parser zuerst herausfinden.
===== Analyse =====
==== Quelldaten ====
Die Dateien sehen zum Beispiel so aus
Date 03/11/201>
User Max Muster
Willkommen Max Muster und Blah und sowieso
viele unütze Zeilen
nicht wahr?
Account ABC-123
time ID what price local
1130 12 Coffee 1.25 EUR 1.25 EUR
Div. 3.26 EUR 3.26 EUR
Total ABC-123 4.51 EUR
Account DEF-456
time ID what price local
1145 25 xy 5.25 CHF 4.90 EUR
1146 26 dfr 4.00 USD 3.70 EUR
okhgg 1.50 USD 1.39 EUR
1543 27 oppojkj 3.00 EUR 3.00 EUR
Total DEF-456 12.99 UER
Viel unnötiger Text etc.
Die ersten 2 Zeilen sind Grund-Informationen. Die will ich nachher in meiner DB in jeder Zeile sehen
Dann kommt BlahBlah Blah.
Gefolgt von einem Account. Der Interessiert mich.
Dann kommt eine Tabelle. Da will ich jeden Eintrag haben. Die Zeit und ID soll sich wiederholen.
So soll mein Resultat aussehen
==== Gewünschtes Resultat ====
date | time | user | account | id | what | product_price | product_currency | local_price | local_currency
-------------------------------------------------------------------------------------------------------------------------
03/11/2017 | 11:30 | Max Muster | ABC-123 | 12 | Coffee | 1.25 | EUR | 1.25 | EUR
03/11/2017 | 11:30 | Max Muster | ABC-123 | 12 | Div. | 3.26 | EUR | 3.26 | EUR
03/11/2017 | 11:45 | Max Muster | DEF-456 | 25 | xy | 5.25 | CHF | 4.90 | EUR
03/11/2017 | 11:46 | Max Muster | DEF-456 | 26 | dfr | 4.00 | USD | 3.70 | EUR
03/11/2017 | 11:46 | Max Muster | DEF-456 | 26 | okhgg | 1.50 | USD | 1.39 | EUR
03/11/2017 | 15:43 | Max Muster | DEF-456 | 27 | oppojkj | 3.00 | EUR | 3.00 | EUR
===== Lösung =====
==== RegExp ====
Dann gehen wir mal ans Werk. Die einzelnen Zeilen werden mittels RegExp gescannt und ausgewertet.
Folgende Zeilen brauche ich
''Date/User/Account Wert
\\ 1130 12 Coffee 1.25 EUR 1.25 EUR''
Das gibt also 2 verschiedene RegExp. Da RegExp am schnellsten ist, wenn es nicht jedes mal initialisiert werde muss, Schreibe ich dafür Private Properties mit einem Static Object
'Date 03/11/2017
'Ausgabe: Date/User/Account, Wert
Private Property Get rxSingle() As Object
Static rx As Object
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.pattern = "^(Date|User|Account)\s+(.+)"
rx.IgnoreCase = True
End If
Set rxSingle = rx
End Property
'1130 12 Coffee 1.25 EUR 1.25 EUR
' Div. 3.26 EUR 3.26 EUR
'Ausgabe: time, ID, what, product_price, product_currency, local_price, local_currency
Private Property Get rxData() As Object
Static rx As Object
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.pattern = "(\d{4})?\s+(\d+)?\s+(.+?)\s+(\d+\.\d{2})\s+([a-z]{3})\s+(\d+\.\d{2})\s+([a-z]{3})"
rx.IgnoreCase = True
End If
Set rxData = rx
End Property
rxSingle Gibt indem Fall ein Treffer zurück, der 2 SubMatches beinhaltet. Der Name der Variable (Date, User oder Account) und den dazugehörigen Wert.
\\ rxData wertet die Tabellenzeilen aus und gibt alle Feldinhalte zurück
==== Funktion ====
Als nächstes können wir bereits die eigentliche Funktion schreiben.
\\ Darin öffne ich über FileSystemObject die Datei als Stream und iteriere sie Zeilenweise
Public Sub readMyFile()
Dim fso As Object
Dim stream As Object
Dim line As String
'Datei als Stream öffnen
Set fso = CreateObject("Scripting.FileSystemObject")
Set stream = fso.OpenTextFile("C:\_TMP\test.txt", ForReading)
'Zeilenweises abarbeiten
Do While Not stream.AtEndOfStream
line = stream.ReadLine
'//TODO: Zeile auswerten
loop
stream.Close
End Sub
Noch kurz die Variablen für die Auswertung definieren
Dim dateVal As Date, timeVal As Date
Dim user As String, account As String, what As String, product_currency As String, local_currency As String
Dim id As Long
Dim product_price As Double, local_price As Double
Jetzt kommt die Zeilenauswertung mit den rx-Properties.
Für die einfachen Werte. Date, User, Account. Da die Information, um welches Attribut es sich handelt, im ersten SubMatch befindet, wird dieses mittels Select Case ausgewertet
If rxSingle.Test(line) Then
'Den Single-Wert setzen
Set sm = rxSingle.execute(line)(0).subMatches
Select Case LCase(sm(0))
Case "date": dateVal = sm(1)
Case "user": user = sm(1)
Case "account": account = sm(1)
End Select
End If
Und die Datenzeilen.
Hier entspricht jeder SubMatch einer Variable. Die 2 Ersten SubMatches können leer sein, wie wir in den Daten gesehen haben. In dem Fall dürfen die Variablen nicht überschrieben werden
If rxData.Test(line) Then
'Eine Zeile auswerten
'time, ID, what, product_price, product_currency, local_price, local_currency
Set sm = rxData.execute(line)(0).subMatches
'Die ersten 2 Spalten können leer sein. Dann soll der Wert nicht mit Leer überschrieben werden
If sm(0) <> Empty Then timeVal = timeValue(format(sm(0), "00:00"))
If sm(1) <> Empty Then id = CLng(sm(1))
what = sm(2)
product_price = CDbl(sm(3))
product_currency = sm(4)
local_price = CDbl(sm(5))
local_currency = sm(6)
'//TODO: Mit den Variablen irgendwas machen
End If
Und schon haben wir alle Daten zusammen. Fürs Beispiel gebe ich sie nur im Direktfenster aus. In Der Praxis könnte man diese jetzt in eine DB speichern oder einer anderen Methode übergeben
'Die Daten ausgeben. Hier nur per debug.print. Man kann damit jetzt aber machen was man will
Debug.Print dateVal, timeVal, user, account, id, what, product_price, product_currency, local_price, local_currency
==== Vollständige Lsöung ====
Hier der fertige Code
Public Sub readMyFile()
Dim fso As Object
Dim stream As Object
Dim line As String
Dim sm As Object
Dim dateVal As Date, timeVal As Date
Dim user As String, account As String, what As String, product_currency As String, local_currency As String
Dim id As Long
Dim product_price As Double, local_price As Double
'Datei als Stream öffnen
Set fso = CreateObject("Scripting.FileSystemObject")
Set stream = fso.OpenTextFile("C:\_TMP\test.txt", ForReading)
'Zeilenweises abarbeiten
Do While Not stream.AtEndOfStream
line = stream.ReadLine
If rxSingle.Test(line) Then
'Den Single-Wert setzen
Set sm = rxSingle.execute(line)(0).subMatches
Select Case LCase(sm(0))
Case "date": dateVal = sm(1)
Case "user": user = sm(1)
Case "account": account = sm(1)
End Select
ElseIf rxData.Test(line) Then
'Eine Zeile auswerten
'time, ID, what, product_price, product_currency, local_price, local_currency
Set sm = rxData.execute(line)(0).subMatches
'Die ersten 2 Spalten können leer sein. Dann soll der Wert nicht mit Leer überschrieben werden
If sm(0) <> Empty Then timeVal = timeValue(format(sm(0), "00:00"))
If sm(1) <> Empty Then id = CLng(sm(1))
what = sm(2)
product_price = CDbl(sm(3))
product_currency = sm(4)
local_price = CDbl(sm(5))
local_currency = sm(6)
'Die Daten ausgeben. Hier nur per debug.print. Man kann damit jetzt aber machen was man will
Debug.Print dateVal, timeVal, user, account, id, what, product_price, product_currency, local_price, local_currency
End If
Loop
stream.Close
End Sub
'Date 03/11/2017
'Ausgabe: Date/User/Account, Wert
Private Property Get rxSingle() As Object
Static rx As Object
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.pattern = "^(Date|User|Account)\s+(.+)"
rx.IgnoreCase = True
End If
Set rxSingle = rx
End Property
'1130 12 Coffee 1.25 EUR 1.25 EUR
' Div. 3.26 EUR 3.26 EUR
'Ausgabe: time, ID, what, product_price, product_currency, local_price, local_currency
Private Property Get rxData() As Object
Static rx As Object
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.pattern = "(\d{4})?\s+(\d+)?\s+(.+?)\s+(\d+\.\d{2})\s+([a-z]{3})\s+(\d+\.\d{2})\s+([a-z]{3})"
rx.IgnoreCase = True
End If
Set rxData = rx
End Property
Und die Ausgabe im Direktfenster
03.11.2017 11:30:00 Max Muster ABC-123 12 Coffee 1.25 EUR 1.25 EU>
03.11.2017 11:30:00 Max Muster ABC-123 12 Div. 3.26 EUR 3.26 EUR
03.11.2017 11:45:00 Max Muster DEF-456 25 xy 5.25 CHF 4.9 EUR
03.11.2017 11:46:00 Max Muster DEF-456 26 dfr 4 USD 3.7 EUR
03.11.2017 11:46:00 Max Muster DEF-456 26 okhgg 1.5 USD 1.39 EUR
03.11.2017 15:43:00 Max Muster DEF-456 27 oppojkj 3 EUR 3 EUR