解析 JSON，MS Access VBA（嵌套循环）答案

【问题标题】：Parse JSON, MS Access VBA (nested loops)解析 JSON，MS Access VBA（嵌套循环）
【发布时间】：2018-09-04 19:41:26
【问题描述】：

StackOverflow 的好人！

我正在尝试弄清楚如何连接到 Airtable API，从那里获取 JSON 并使用结果填充 Access 表。

到目前为止，至少我设法将请求限制为只给我需要的几个字段。结果如下所示：

{
  "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"
  }]
}

从那时起，我已经阅读了 Tim Hall 的如何使用 VBA-JSON 的尽可能多的示例（感谢 Tim，创建它 :)

据我了解，就我而言，ParseJson 函数返回一个字典。里面是一个名为“results”的集合，而该集合里面是另一个名为“fields”的字典。我需要的是该字典中键“小时”、“日期”和“项目”的值。

我曾尝试执行这三个循环（通过字典内的集合内的字典循环）并且由于各种错误而失败了很多次。最后，我已经到了看不到更多错误的地步，子高兴地给我“导入完成！”信息。唉，我的桌子是空的！什么，我做错了什么？

我希望我给了你足够的信息，并提前非常感谢你的帮助！

（如果重要的话，我正在 64 位 Windows 上使用 32 位 Access 2016）

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

【问题讨论】：

标签： json vba dictionary ms-access collections

【解决方案1】：

条目Project 包含一个数组，因此取第一个项：

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

【讨论】：