Parse JSON, MS Access VBA (nested loops)

Question

good people of StackOverflow!

I am trying to figure out how to connect to Airtable API, get JSON from there and populate Access table with the results.

So far, at least I managed to restrict the request to give me only a few fields I need.The result looks like this:

{
  "records": [{
    "id": "rec008lgyvVmwk1F4",
    "fields": {
      "Date": "2018-02-28"
    },
    "createdTime": "2018-01-26T15:36:23.000Z"
  }, {
    "id": "rec02WozJeaGvfBfj",
    "fields": {
      "Hours": 1.5,
      "Date": "2018-02-09",
      "Project": ["Nonbillable"]
    },
    "createdTime": "2018-02-12T17:03:18.000Z"
  }, {
    "id": "rec05VxP0CYTsDYOA",
    "fields": {
      "Date": "2018-02-08"
    },
    "createdTime": "2018-02-01T10:29:52.000Z"
  }, {
    "id": "rec05xoQEm5iWIYmz",
    "fields": {
      "Hours": 0.75,
      "Date": "2018-02-16",
      "Project": ["2018 - Japan DLAs"]
    },
    "createdTime": "2018-02-19T09:29:18.000Z"
  }]
}

From that point on I have read as many examples as I could find how to use VBA-JSON by Tim Hall (thank you Tim, for creating it :)

As far as I understand, in my case the ParseJson function returns a dictionary. Inside that is a collection named 'results' and inside that collection is another dictionary named 'fields'. What I need are values for keys 'Hours', 'Date' and 'Project' from that dictionary.

I have tried to do those three loops (loop through dictionary inside collection inside dictionary) and was failing miserably many times with a variety of errors. Finally, I have come to the point where I see no more errors, the sub happily gives me "Import done!" message. Alas, my table is empty! What, what am I doing wrong?

I hope I gave you enough information and thank you very much in advance for your help!

(If it matters, I'm working with 32-bit Access 2016 on 64-bit Windows)

Public Sub ImportJSON()

    Dim reader As New XMLHTTP60
    Dim JsonRetrieved As String
    Dim Parsed As Scripting.Dictionary
    Dim records As New Collection
    Dim fields As Scripting.Dictionary
    Dim item As Variant
    Dim rs As New ADODB.Recordset


    reader.Open "GET", "https://api.airtable.com/v0/apppLTTgKBsw5QmUX/myTable?fields[]=Project&fields[]=Hours&NOT({Hours} = '')&fields[]=Date&NOT({Date} = '')&maxRecords=4&api_key=mykey", False

    reader.setRequestHeader "Accept", "application/json"

    reader.Send

    Do Until reader.ReadyState = 4
        DoEvents
    Loop

    If reader.Status = 200 Then

        rs.Open "tblAirtableImport", CurrentProject.Connection, _
         adOpenKeyset, adLockOptimistic

        JsonRetrieved = reader.responseText
        'Debug.Print JsonRetrieved

       Set Parsed = JsonConverter.ParseJson(JsonRetrieved)

        'loop through dictionary 'Parsed'
        Dim i As Long
        For i = 0 To Parsed.Count - 1

            'loop through collection 'records'. If we have hours logged into Airtable add new record (Hours, Date, Project) to Access table
            For Each fields In records

                'loop through dictionary 'fields'
                Dim j As Long
                For j = 0 To fields.Count - 1

                    If fields.Exists("Hours") Then
                    'MsgBox "We have hours in this row"


                        rs.AddNew

                        rs!AirtableHours = fields.item("Hours")
                        rs!AirtableDate = fields.item("Date")
                        rs!AirtableProject = fields.item("Project")

                        rs.Update
                    Else
                        MsgBox "No logged time."
                    End If

                Next j
            Next

        Next i

        MsgBox "Import done!"
        Set Parsed = Nothing

    Else
        MsgBox "Ups, unable to import data. Reader status is: " & reader.Status
    End If    

End Sub

Answer 1

The entry Project holds an Array so take the first Item:

Set Parsed = JsonConverter.ParseJson(JsonRetrieved)

For Each record In Parsed("records")
    Set fields = record("fields")

    If fields.Exists("Hours") Then
        rs.AddNew
        rs!AirtableHours = fields("Hours")
        rs!AirtableDate = fields("Date")
        rs!AirtableProject = fields("Project")(1)
        rs.Update
    End If
Next