-2

I'm using this JSON library by omegastripes to import json files into an Access database. This post has a pretty good solution, but you need to know the field names ahead of time. I'm looking for a more generic sub to pull any flattened json object into a table (creating the table first if it doesn't exist), and I can create the table relationships later.

In most cases, I only need a portion of the json file I'm working with. For example, with the json below I can ignore the "meta", and the "phones" sections:

{
  "contacts": [
    {
      "id": 9785,
      "type": "Individual",
      "first_name": "John",
      "middle_name": "Jacob",
      "last_name": "Jingleheimer-Schmidt",
      "suffix": "Sr.",
      "company_name": null,
      "added_by": 337864,
      "phones": [
        {
          "id": 204,
          "number": "8884447777"
        }
      ]
    },
    {
      "id": 9887,
      "type": "Individual",
      "first_name": "John",
      "middle_name": "Jacob",
      "last_name": "Jingleheimer-Schmidt",
      "suffix": "Jr.",
      "company_name": null,
      "added_by": 337864,
      "phones": []
    },
    {
      "id": 8556,
      "type": "Business",
      "first_name": null,
      "middle_name": null,
      "last_name": null,
      "company_name": "J&J Construction",
      "added_by": null,
      "phones": [
        {
          "id": 13168,
          "number": "5557779999"
        },
        {
          "id": 13169,
          "number": "2224446666"
        }
      ]
    }
  ],
  "meta": {
    "total_records": 3,
    "total_pages": 1
  }
}
MaybeOn8
  • 45
  • 9
  • "I'm looking for a more generic sub to pull any flattened json object into a table (creating the table first if it doesn't exist)" This will create random table-names, and random-table-fieldnames ? And HOW ar you going to query those random (read: unknown table- or field- names? – Luuk Apr 28 '23 at 18:32
  • That's kind of the point - I'm dealing with an API that can call many different "random" types of JSON files. Rather than build a function for each one, I wanted a function that could import any of them, [so I built it](https://stackoverflow.com/a/76132245/12735176). The table name is passed in as a parameter. The field names are pulled from the JSON file. Once the table exists, calling the function again will append new records. Now I can build more specific functions that call this generic one first, and then query the data like any other table once it's been imported. – MaybeOn8 Apr 28 '23 at 19:06

1 Answers1

0

Ended up building the solution before I finished posting my question. Here's what I made! This will build a table from the parsed json object, OR any of its sub-objects/arrays. Copy the ToTable function into the JSON module...

Public Function ToTable(vJSON, tblName As String) As Long
    ' Input:
    ' vJSON - Array or Object which contains rows data
    ' tblName - the name of the access table to create / append to
    ' Output:  Returns 0 if successful. Otherwise returns an error code
    On Error GoTo Exit_Handler
    Dim db As Database, rs As Recordset, arr(), k, v
    
    Select Case varType(vJSON)
    Case Is >= vbArray
        If SizeOf(vJSON) = 0 Then Err.Raise 53, "JSON.ToTable", "The JSON object is empty"
        arr = vJSON
    Case vbObject   'place vJSON inside an array of 1 so the loops don't error out
        ReDim arr(0)
        Set arr(0) = vJSON
    End Select

    Set db = CurrentDb
    If IsNull(DLookup("Name", "MSysObjects", "Name='" & tblName & "'")) Then
        'if tblName doesn't already exist...
        Dim tblFields$, vType$
        
        For Each k In arr(0)    'get field type based on the first record in each field
            Select Case varType(arr(0)(k))
            Case vbBoolean
                tblFields = tblFields & ", [" & k & "] BIT"
            Case vbDouble
                tblFields = tblFields & ", [" & k & "] FLOAT"
            Case vbDate
                tblFields = tblFields & ", [" & k & "] DATETIME"
            Case Else
                If Len(k) Then tblFields = tblFields & ", [" & k & "] VARCHAR"
            End Select
        Next
        If Len(tblFields) = 0 Then Err.Raise 59, "JSON.ToTable", "There are no field names to add."
        'create new tbl
        db.Execute "CREATE TABLE [" & tblName & "](" & Mid(tblFields, 2) & ");"
    End If
    Set rs = db.OpenRecordset(tblName, dbOpenTable, dbAppendOnly)
    
    'add records to fields
    For i = LBound(arr) To UBound(arr)
        rs.AddNew
        For Each k In arr(i)
            If Len(k) Then
                Select Case varType(arr(i)(k))
                Case vbObject
                    rs.Fields(k) = "{...}"
                Case Is >= vbArray
                    rs.Fields(k) = "[...]"
                Case Else
                    rs.Fields(k) = arr(i)(k)
                End Select
            End If
        Next
        rs.Update
    Next
    
Exit_Handler:
    ToTable = Err
    If Err = 3265 Then
        MsgBox "Error 3265 - You are trying to import to a field that does not exist in the table: '" & tblName & "'. Try passing in a different tblName, or deleting this table.", , "JSON.ToTable Error"
    ElseIf Err Then
        MsgBox "Run time error #" & Err.Number & " " & Error$, , Err.Source
    End If
End Function

...and then run test_me to try it out:

Sub test_me()
    Const sJSON = "{""contacts"":[{""id"":9785,""type"":""Individual"",""first_name"":""John"",""middle_name"":""Jacob"",""last_name"":""Jingleheimer-Schmidt"",""suffix"":""Sr."",""company_name"":null,""added_by"":337864,""phones"":[{""id"":204,""number"":""8884447777""}]},{""id"":9887,""type"":""Individual"",""first_name"":""John"",""middle_name"":""Jacob"",""last_name"":""Jingleheimer-Schmidt"",""suffix"":""Jr."",""company_name"":null,""added_by"":337864,""phones"":[]},{""id"":8556,""type"":""Business"",""first_name"":null,""middle_name"":null,""last_name"":null,""company_name"":""J&J Construction"",""added_by"":null,""phones"":[{""id"":13168,""number"":""5557779999""},{""id"":13169,""number"":""2224446666""}]}],""meta"":{""total_records"":3,""total_pages"":1}}"
    Dim oJSON
    JSON.Parse sJSON, oJSON
    
'uncomment one of theses lines to import only a portion of the json object. You might want to change "yourTableName" to something else between runs:
'    oJSON = oJSON("contacts")   'import a sub-array
'    Set oJSON = oJSON("meta")   'import a sub-object

    JSON.ToTable oJSON, "yourTableName"
End Sub
MaybeOn8
  • 45
  • 9