====== [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