Yaslaw.Info

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== [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
<code>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.</code>

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 ====
<code>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
</code>

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

<code vb>'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</code>
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
<code vb>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</code>

Noch kurz die Variablen für die Auswertung definieren
<code vb>    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</code>

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
<code VB>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</code>
 
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
 <code vb>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</code>

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
<code VB>'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</code>

==== Vollständige Lsöung ====
Hier der fertige Code
<code vb>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</code>

Und die Ausgabe im Direktfenster
<code>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</code>
Yaslaw.Info

User Tools

Site Tools

Page Tools
