JSON-Daten mit der vbRichClient-Library parsen

Aus DBWiki
Wechseln zu: Navigation, Suche

Problemstellung

Ich erhalte JSON-Daten aus Web-Requests und möchte diese in eine Tabellenstruktur überführten. Im speziellen Fall will ich dazu Olaf Schmidts vbRichClient-Bibliothek einsetzen, weil sie bereits einen schnellen JSON-Parser integriert hat.

Meine Daten sehen beispielsweise so aus:

{
  "1": [
    {
      "key": "amount",
      "value": 10
    },
    {
      "key": "date",
      "value": "2018-05-02"
    },
    {
      "key": "name",
      "value": "Kim"
    }
  ],
  "2": [
    {
      "key": "amount",
      "value": 32
    },
    {
      "key": "date",
      "value": "2018-05-03"
    },
    {
      "key": "name",
      "value": "Sam"
    }
  ],
  "3": [
    {
      "key": "amount",
      "value": 12.5
    },
    {
      "key": "name",
      "value": "Tom"
    },
    {
      "key": "date",
      "value": "2018-05-04"
    }
  ]
}

Lösung

Zuerst müssen die Daten aus dem Link oben heruntergeladen und am besten in einen eigenen Ordner kopiert und anschließend mit dem beiliegendem Script (als Administrator ausführen) registriert werden.

Die gezeigte Routine nutzt neben der cCollection-Klasse auch die beiliegende SQLite3-Bibliothek, um eine Datenbank-Tabelle nur im Speicher zu nutzen. Selbstverständlich kann man den Transfer auch in eine Access-Datenbank umleiten oder ein cRecordset in ein ADO-Recordset umwandeln.

Danach kann folgender Code zum Parsen der Daten verwendet werden. Zusätzlich muss ein Verweis auf die Bibliothek im VBA-Editor unter vbRichClient5 gesetzt werden.

Public Sub ParseToMemDB()
 
   'Quelle: http://www.dbwiki.net/
 
 
   'unsere Beispieldaten (unformatiert)
   Const SAMPLE_JSON As String = _
         "{""1"":[{""key"":""amount"",""value"":10}," & _
         "{""key"":""date"",""value"":""2018-05-02""}," & _
         "{""key"":""name"",""value"":""Kim""}]," & _
         """2"":[{""key"":""amount"",""value"":32}," & _
         "{""key"":""date"",""value"":""2018-05-03""}," & _
         "{""key"":""name"",""value"":""Sam""}]," & _
         """3"":[{""key"":""amount"",""value"":12.5}," & _
         "{""key"":""name"",""value"":""Tom""}," & _
         "{""key"":""date"",""value"":""2018-05-04""}]}"
 
   Dim mdb  As cMemDB
   Dim json As cCollection
   Dim rec  As cCollection
   Dim rows As Variant
   Dim i    As Long
   Dim j    As Long
 
   Set mdb = New_c.MemDB   'neue SQLite3 Datenbank im Speicher anlegen
   With mdb.NewFieldDefs   'Felddefinitionen erstellen
      .Add "Id        Integer Primary Key"
      .Add "Name      Varchar(10) Not Null"
      .Add "Date      ShortDate Not Null"
      .Add "Amount    Decimal(5,2) Not Null"
   End With
   mdb.CreateTable "Temp"  'Tabelle 'Temp' erzeugen
 
   Set json = New_c.JSONDecodeToCollection(SAMPLE_JSON)  'JSON-Daten parsen
   mdb.BeginTrans          'eine Transaktion beschleunigt den Ablauf
 
   'Anfügeabfrage mit vier Parametern verwenden
   With mdb.Cnn.CreateCommand("INSERT INTO Temp VALUES (?,?,?,?)")
      'für alle Schlüssel (das sind "1", "2" und "3")
      For i = 0 To json.Count - 1
         'den ersten Parameter für "Id" setzen
         .SetInt64 1, json.KeyByIndex(i)
         'für jedes Objekt 'rec' der ausgewählten "Id"
         For Each rec In json(json.KeyByIndex(i))
            'die Angabe unter 'key' prüfen und Parameter
            'aus 'value' setzen
            Select Case rec("key")
            Case "name"
               .SetText 2, rec("value")
            Case "date"
               .SetDate 3, CDate(rec("value"))
            Case "amount"
               .SetDouble 4, rec("value")
            End Select
         Next
         'Datensatz schreiben
         .Execute
      Next
   End With
   'Transaktion abschließen
   mdb.CommitTrans
 
   'ein Recordset mit allen Daten aus 'Temp' anlegen
   With mdb.GetRs("select * from temp")
      '... und in Array transformieren (erste Zeile enthält Feldnamen)
      rows = .GetRowsWithHeaders(, , , True, True)
      'für jeden Datensatz 'i'
      For i = LBound(rows, 1) To UBound(rows, 1)
         'für jedes Feld
         For j = LBound(rows, 2) To UBound(rows, 2)
            'Wert in Direktfenster ausgeben
            Debug.Print rows(i, j),
         Next
         Debug.Print
      Next
   End With
 
End Sub

Die Ausgabe im Direktfenster schaut dann so aus:

Id            Name          Date          Amount
 1            Kim           02.05.2018     10
 2            Sam           03.05.2018     32
 3            Tom           04.05.2018     12,5