Search code examples
jsonvbams-access

Importing JSON file to MS Access table

I am trying to import a JSON file into an MS Access table. I have looked online and found this Stack overflow link that speaks to this. Parsing JSON feed automatically into MS Access I have copied and pasted the code from this string and modified it to pull my JSON file and the code does appear to parse the file. However, I'm having problems getting all elements of the parsed file into the Access table. It seems to only pull in elements that are not part of an object or array. In other words, the NPI element is not wrapped in brackets or curly brackets so it imports successfully. Please see code and JSON data structure below.

Private Function JSONImport()
Dim db As Database, qdef As QueryDef
Dim FileNum As Integer
Dim DataLine As String, jsonStr As String, strSQL As String
Dim P As Object, element As Variant

Set db = CurrentDb

' READ FROM EXTERNAL FILE
FileNum = FreeFile()
'Open "P:\PROF REIMB\PROF REIMB\HIX\CY 2021 Analysis\Centene\JSON\provider_facility - jun 52020.json" 
For Input As #FileNum
' PARSE FILE STRING
jsonStr = ""
While Not EOF(FileNum)
    Line Input #FileNum, DataLine
    jsonStr = jsonStr & DataLine & vbNewLine
Wend
Close #FileNum
Set P = ParseJson(jsonStr)

' ITERATE THROUGH DATA ROWS, APPENDING TO TABLE
For Each element In P
    strSQL = "PARAMETERS (first), [middle] Text(255), [last] Text(255), [suffix] Text(255), [npi] 
    Text(255), [type] Text(255), [addresses] Text(255), [addresses_2] Text(255), [city] Text(255), 
    [state] Text(255), [zip] Text(255), [phone] Text(255), [specialty] Text(255), [accepting] 
    Text(255), [plans] Text(255), [plan_id_type] Text(255), [plan_id] Text(255), [network_tier] 
    Text(255), [years] Text(255); " _

    & "INSERT INTO FrmJSONFile (first,  middle,  last,  suffix,  npi,  type,  addresses,  
    addresses_2,  city,  state,  zip,  phone,  specialty,  accepting,  plans,  plan_id_type,  
    plan_id,  network_tier,  years) " _

    & "VALUES([first], [middle], [last], [suffix], [npi], [type], [addresses], [addresses_2], [city], 
    [state], [zip], [phone], [specialty], [accepting], [plans], [plan_id_type], [plan_id], 
    [network_tier], [years]);"

    Set qdef = db.CreateQueryDef("", strSQL)

    qdef!first = element("first")
    qdef!middle = element("middle")
    qdef!last = element("last")
    qdef!suffix = element("suffix")
    qdef!npi = element("npi")
    qdef!Type = element("type")
    qdef!addresses = element("addresses")
    qdef!addresses_2 = element("addresses_2")
    qdef!city = element("city")
    qdef!State = element("state")
    qdef!Zip = element("zip")
    qdef!phone = element("phone")
    qdef!specialty = element("specialty")
    qdef!accepting = element("accepting")
    qdef!plans = element("plans")
    qdef!plan_id_type = element("plan_id_type")
    qdef!plan_id = element("plan_id")
    qdef!network_tier = element("network_tier")
    qdef!years = element("years")

    qdef.Execute
Next element

Set element = Nothing
Set P = Nothing

End Function

JSON file:

[{
 "name":{
      "first":"John","middle":"G","last":"Doe","suffix":"MD"
  },
  "npi":"1234567891",
  "type":"INDIVIDUAL",
  "addresses":[
    {"address":"123 Main St",
     "address_2":"",
     "city":"CHARLESTON",
     "state":"SC",
     "zip":"29406",
     "phone":"8037779311"}
   ],
   "specialty":["ANESTHESIOLOGY"],
   "accepting":"not accepting",
   "plans":[
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678912",
          "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678913",
           "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678914",
           "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678915",
           "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678916",
           "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678917",
           "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678918",
           "network_tier":"PREFERRED","years":[2020]},
         {"plan_id_type":"HIOS-PLAN-ID","plan_id":"12345678919",
           "network_tier":"PREFERRED","years":[2020]}
     ],
     "languages":["ENGLISH"],
     "gender":"Male",
     "last_updated_on":"2020-05-26"
  }]
Solution

  • Because your JSON is a nested collection (unlike the simpler, flat linked question), you need to extract parameter values at deeper levels. The VBA-JSON module maps every [...] as a collection and every {...} as a dictionary. Relatedly, consider importing into two tables for individuals and plans, possibly using npi as related unique identifier. This is the essential model of a relational database! Don't just import data like a spreadsheet! Finally, use saved queries and avoid the messy string concatenation in VBA.

    Related Tables Diagram

    SQL

    Individuals Append Query (save as a stored query to be called in VBA)

    PARAMETERS [prm_first] Text ( 255 ), [prm_middle] Text ( 255 ), [prm_last] Text ( 255 ), 
           [prm_suffix] Text ( 255 ), [prm_npi] Text ( 255 ), [prm_type] Text ( 255 ), 
           [prm_addresses] Text ( 255 ), [prm_addresses_2] Text ( 255 ), [prm_city] Text ( 255 ), 
           [prm_state] Text ( 255 ), [prm_zip] Text ( 255 ), [prm_phone] Text ( 255 ), 
           [prm_specialty] Text ( 255 ), [prm_accepting] Text ( 255 );
INSERT INTO individuals ( [first], middle, [last], suffix, npi, type, addresses, 
                         addresses_2, city, state, zip, phone, specialty, accepting )
VALUES ([prm_first], [prm_middle], [prm_last], [prm_suffix], [prm_npi], [prm_type], 
        [prm_addresses], [prm_addresses_2], [prm_city], [prm_state], [prm_zip], 
        [prm_phone], [prm_specialty], [prm_accepting]);

    Plans Append Query (save as a stored query to be called in VBA)

    PARAMETERS [prm_npi] Text ( 255 ), [prm_plan_id_type] Text ( 255 ), [prm_plan_id] Text ( 255 ), 
           [prm_network_tier] Text ( 255 ), [prm_years] Long;
INSERT INTO plans ( npi, plan_id_type, plan_id, network_tier, years )
VALUES ([prm_npi], [prm_plan_id_type], [prm_plan_id], [prm_network_tier], [prm_years]);

    VBA

    Private Function JSONImport()
    Dim db As Database, qdef As QueryDef
    Dim FileNum As Integer
    Dim DataLine As String, jsonStr As String, strSQL As String
    Dim P As Object, element As Variant, sub_el As Variant

    Set db = CurrentDb

    ' READ FROM EXTERNAL FILE
    FileNum = FreeFile()
    Open "C:\Path\To\myJSON.json" For Input As #FileNum

    ' PARSE FILE STRING
    jsonStr = ""
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine
        jsonStr = jsonStr & DataLine & vbNewLine
    Wend
    Close #FileNum
    Set P = ParseJson(jsonStr)

    ' ITERATE THROUGH DATA ROWS, APPENDING TO TABLE
    For Each element In P

        ' INDIVIDUALS QUERY
        Set qdef = db.QueryDefs("qryIndividualsAppend")

        qdef!prm_first = element("name")("first")
        qdef!prm_middle = element("name")("middle")
        qdef!prm_last = element("name")("last")
        qdef!prm_suffix = element("name")("suffix")
        qdef!prm_npi = element("npi")
        qdef!prm_type = element("type")
        qdef!prm_addresses = element("addresses")(1)("address")
        qdef!prm_addresses_2 = element("addresses")(1)("addresses_2")
        qdef!prm_city = element("addresses")(1)("city")
        qdef!prm_state = element("addresses")(1)("state")
        qdef!prm_Zip = element("addresses")(1)("zip")
        qdef!prm_phone = element("addresses")(1)("phone")
        qdef!prm_specialty = element("specialty")(1)
        qdef!prm_accepting = element("accepting")

        qdef.Execute
        Set qdef = Nothing

        ' PLANS QUERY
        Set qdef = db.QueryDefs("qryPlansAppend")

        ' NESTED ITERATION THROUGH EACH PLANS ITEMS
         For Each sub_el In element("plans")
            qdef!prm_npi = element("npi")
            qdef!prm_plan_id_type = sub_el("plan_id_type")
            qdef!prm_plan_id = sub_el("plan_id")
            qdef!prm_network_tier = sub_el("network_tier")
            qdef!prm_years = sub_el("years")(1)

            qdef.Execute
         Next sub_el
    Next element

    Set element = Nothing: Set P = Nothing
    Set qdef = Nothing: Set db = Nothing
End Function