Eine Datei mit RegeExp zeilenweise durchsuchen und die Resultate verwerten

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.

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

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

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

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

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