时间戳

首页 > 解决方案 > 如何使用嵌套 JSON 中的 VBA 填充 excel？

json - 如何使用嵌套 JSON 中的 VBA 填充 excel？

问题描述

JSON 响应

  "error": null,
  "metadata": {
    "total": 1,
    "limit": 1000,
    "offset": 0
  },
  "data": [
    {
      "id": 1,
  "description": "10 licenses",
  "closeDate": "2018-05-22",
  "date": "2018-05-22",
  "notes": "",
  "user": {
    "id": 1,
    "name": "Gustav Petterson",
    "role": null,
    "email": "apidocs@upsales.com"
  },
  "client": {
    "name": "Pied piper",
    "id": 2,
    "users": [
      {
        "id": 1,
        "name": "Gustav Petterson",
        "role": null,
        "email": "apidocs@upsales.com"
      }
    ]
  },
  "contact": null,
  "project": null,
  "regDate": "2018-05-22T11:08:26.000Z",
  "stage": {
    "name": "Won - Order",
    "id": 12
  },
  "probability": 100,
  "modDate": "2018-05-22T11:13:59.000Z",
  "clientConnection": null,
  "currencyRate": 1,
  "currency": "SEK",
  "locked": 0,
  "custom": [
    {
      "value": "2018-05-23",
      "valueDate": "2018-05-23",
      "orgNumber": 20180523,
      "fieldId": 1
    }
  ],
  "orderRow": [
    {
      "id": 1,
      "quantity": 1,
      "price": 10000,
      "discount": 0,
      "custom": [],
      "productId": 1,
      "sortId": 1,
      "listPrice": 10000,
      "product": {
        "name": "Example product",
        "id": 1,
        "category": null
      }
    }
  ],
  "value": 10000,
  "weightedValue": 10000,
  "valueInMasterCurrency": 10000,
  "weightedValueInMasterCurrency": 10000,
  "agreement": null,
  "userRemovable": true,
  "userEditable": true
}
  ]
}

因此，我试图将其解析到我的工作表中，但现在挣扎了很长时间。我想要做的是将所有订单详细信息放入一张表中，但是多层嵌套部件一直困扰着我。

在“数据”中，一切顺利，直到它运行到第一个嵌套项“用户”即 Dictionary 或“客户端”即 Collection。我试图运行下一个循环来获取嵌套项目，但我造成了更大的混乱。

Sub GetOrders()

Dim sGetResult As String

Dim d_lr As Double

Dim httpObject As Object
Dim dict_json As Object

Dim objData
Dim objOrder

d_lr = LastRow(ActiveSheet)

Set httpObject = CreateObject("MSXML2.XMLHTTP")
        
    sURL = "https://integration.upsales.com/api/v2/orders?token=" & wAdmin.Range("C4") & "&probability=100"
        
    sRequest = sURL
    httpObject.Open "GET", sRequest, False

    httpObject.setRequestHeader "Accept: ", "application/json"
    httpObject.Send
    sGetResult = httpObject.responseText

    Set dict_json = JsonConverter.ParseJson(sGetResult)
    Set objData = dict_json("data")

    For Each objOrder In objData
        For i = 0 To objOrder.Count - 1
            Debug.Print objOrder.Items()(i)
        Next I
    Next objOrder

End Sub

标签： jsonexcelvbadictionarynested

解决方案

您需要测试对象类型并相应地递归。

    Set dict_json = JsonConverter.ParseJson(sGetResult)
    Set objdata = dict_json("data")(1)
    
    Dim k, v, u, p
    For Each k In objdata
    
       If VarType(objdata(k)) = 9 Then ' object
          
            If k = "user" Then
                For Each u In objdata(k)
                    Debug.Print "user", u, objdata(k)(u)
                Next
            End If
          
            If k = "client" Then
                For Each u In objdata(k)
                    If u = "users" Then
                        ' for each loop for users
                        For i = 1 To objdata(k)(u).Count
                            For Each p In objdata(k)(u)(i)
                                Debug.Print "users", i, p, objdata(k)(u)(i)(p)
                            Next
                        Next
                    Else
                        Debug.Print "client", u, objdata(k)(u)
                    End If
                Next
            End If
          
       Else
           Debug.Print k, objdata(k)
       End If
       
    Next

推荐阅读