Question

im现在尝试在Excel中的VBA中解析多个JSON。借助Google和SO，我设法以以下格式解析了多个JSON：

{
  "name": "Starker Geschmeidiger Holz-Langbogen des Feuers",
  "description": "",
  "type": "Weapon",
  "level": 44,
  "rarity": "Masterwork",
  "vendor_value": 120,
  "default_skin": 3942,
  "game_types": [
    "Activity",
    "Wvw",
    "Dungeon",
    "Pve"
  ],
  "flags": [
    "SoulBindOnUse"
  ],
  "restrictions": [],
  "id": 28445,
  "chat_link": "[&AgEdbwAA]",
  "icon": "https://render.guildwars2.com/file/C6110F52DF5AFE0F00A56F9E143E9732176DDDE9/65015.png",
  "details": {
    "type": "LongBow",
    "damage_type": "Physical",
    "min_power": 385,
    "max_power": 452,
    "defense": 0,
    "infusion_slots": [],
    "infix_upgrade": {
      "id": 142,
      "attributes": [
        {
          "attribute": "Power",
          "modifier": 85
        },
        {
          "attribute": "Precision",
          "modifier": 61
        }
      ]
    },
    "suffix_item_id": 24547,
    "secondary_suffix_item_id": ""
  }
}

我这样做：

Private Function Get_Name(id As Integer) As String

 Dim httpObject As Object
 Set httpObject = CreateObject("MSXML2.XMLHTTP")

 sURL = "https://api.guildwars2.com/v2/items/" & id & "?lang=de"

 sRequest = sURL
 httpObject.Open "GET", sRequest, False
 httpObject.send
 sGetResult = httpObject.responseText

 Dim oJSON As Object
 Set oJSON = JsonConverter.ParseJson(sGetResult)

 For Each sItem In oJSON
  If sItem = "name" Then
    Get_Name = oJSON(sItem)
  End If
 Next

End Function

那很好，但是我有一个从API获得的JSON，它具有不同的格式，我也没有设法使其工作。.它具有以下格式：

[
  {
    "id": 12134,
    "category": 5,
    "count": 204
  },
  {
    "id": 12238,
    "category": 5,
    "count": 150
  },
  {
    "id": 12147,
    "category": 5,
    "count": 146
  },
  {
    "id": 12142,
    "category": 5,
    "count": 215
  },
....
]

那是我到目前为止的尝试：

Private Function Get_Anzahl_Im_Lager(id As Integer) As Integer

Dim httpObject As Object
 Set httpObject = CreateObject("MSXML2.XMLHTTP")

 sURL = "https://api.guildwars2.com/v2/account/materials?access_token=" & Tabelle2.Cells(1, 7)

 sRequest = sURL
 httpObject.Open "GET", sRequest, False
 httpObject.send
 sGetResult = httpObject.responseText

 MsgBox sGetResult

 Dim oJSON As Collection
 Set oJSON = JsonConverter.ParseJson(sGetResult)

 MsgBox oJSON

 For Each sItem In oJSON
    'If oJSON(sItem)("id") = id Then
       ' Get_Anzahl_Im_Lager = oJSON(sItem)("count")
   ' End If
   Get_Anzahl_Im_Lager = sItem
   Exit Function
 Next

End Function

问题是，根据调试器，它解析数组，但是我只是在这里得到一个空对象，oJSON为空，而sGetResult在其中有JSON数据。

有解决方案吗？

Answer 1

JSON对象具有两种不同的类型。一个是字典，一个是集合。使用TypeName确定要从responseText中获取的内容并按要求进行处理，例如

Dim item As Long, oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)

Select Case TypeName(oJSON)

Case "Collection"

    For Each item In json
        Debug.Print item("count")
    Next

Case "Dictionary"

    Debug.Print json("name")

End Select

Answer 2

做到了。.有时候我应该从：D的新角度开始思考

Private Function Get_Anzahl_Im_Lager(id As Integer) As Integer

 Dim httpObject As Object
 Set httpObject = CreateObject("MSXML2.XMLHTTP")

 If Not IsEmpty(Tabelle2.Cells(1, 7)) Then
    sURL = "https://api.guildwars2.com/v2/account/materials?access_token=" & Tabelle2.Cells(1, 7)
 Else
    Exit Function
 End If

 sRequest = sURL
 httpObject.Open "GET", sRequest, False
 httpObject.send
 sGetResult = httpObject.responseText

 Dim oJSON As Object
 Set oJSON = JsonConverter.ParseJson(sGetResult)

 Dim sItem, cnt&
 For Each sItem In oJSON
    cnt = cnt + 1
    If oJSON(cnt)("id") = id Then
        Get_Anzahl_Im_Lager = oJSON(cnt)("count")
        Exit Function
    End If
 Next

End Function

在VBA中解析特定JSON时出现问题

2 个答案: