json - 使用 VBA-JSON 从 API "error: object does not support this property or method here"中提取？

Question

尝试使用 VBA-JSON 从 API 中提取特定数据。收到错误:此处对象不支持此属性或方法 |对于 json.Keys 中的每个键。试图找出原因。

当我尝试“For Each Key in json.Key”时，我在标题中收到错误代码。我知道这是因为 Defender_list 是一个数组，所以我需要定义一个对象，但我正在努力研究如何为该对象创建 For 语句(如果这是我需要做的)。我把 For every Key 部分去掉了，因为我知道它是错误的。

Option Explicit

Public Sub WriteOutBattleInfo()
    Dim headers(), r As Long, i As Long, json As Object, key As Variant, ws As Worksheet, defenderList As Object, monsterInfo As Object
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    headers = Array("Username", "Avg BP", "Avg Level", "Opp. Address", "Player ID", "Catch Number", "Monster ID", "Type 1", "Type 2", "Gason Y/N", "Ancestor 1", "Ancestor 2", "Ancestor 3", "Class ID", "Total Level", "Exp", "HP", "PA", "PD", "SA", "SD", "SPD", "Total BP")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.etheremon.com/api/ema_battle/get_rank_castles?v=8588587&trainer_address=0x2fef65e4d69a38bf0dd074079f367cdf176ec0de", False
        .Send
        Set json = JsonConverter.ParseJson(.ResponseText)("data")("defender_list") 'dictionary of dictionaries
    End With
    r = 2
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers

编辑:尝试过这个

Dim obj As Variant
Dim monsterInfo, obj2
Dim types, obj3
Dim ancestors, obj4
Dim totalBattleStats, obj5

For Each obj In json
    Debug.Print obj("username")
    Debug.Print obj("avg_bp")
    Debug.Print obj("avg_level")
    Debug.Print obj("player_id")

    Set monsterInfo = obj("monster_info")
    For Each obj2 In monsterInfo
        Debug.Print obj2("create_index")
        Debug.Print obj2("monster_id")

        Set types = obj("types")
        Debug.Print obj3("types")

        Debug.Print obj2("is_gason")

        Set ancestors = obj("ancestors")
        Debug.Print obj4("ancestors")

        Debug.Print obj2("class_ID")
        Debug.Print obj2("total_level")
        Debug.Print obj2("exp")

        Set totalBattleStats = obj("total_battle_stats")
        Debug.Print obj5("total_battle_stats")

        Debug.Print obj2("total_bp")

Next obj

      Cells.Select
      Selection.Columns.AutoFit



  End Sub

我想专门从“defender_list”中提取。每个“用户名”都有 6 个与之关联的 mon。最重要的是，我想要每个蒙的统计数据，但我已经列出了 headers= 中需要的所有内容。代码的变量名称为“username”、“avg_bp”、“avg_level”、“player_id”，然后在“monster_info”中为“create_index”、“monster”id”、“types”(数组 type1、type2)、“is_gason” ", "ancestors"(数组祖先 1,2,3)，"class_id"，"total_level"，"exp"，total_battle_stats(数组 hp, pa, pd, sa, sd, spd)，"total_bp"。

预期输出是:

地点:
用户名 - “用户名”
平均血压 - “avg_bp”
平均级别 - “avg_level”
玩家 ID - “player_id”
捕获编号 - “create_index”
怪物ID - “怪物”id“
类型 1、类型 2 - “类型”(数组 type1、type2)
加森 - “is_gason”
Ancestor 1、Ancestor 2、Ancestor 3 - “祖先”(数组祖先 1,2,3)
类别 ID - “class_id”
总级别 - “total_level”
经验-“经验”
HP、PA、PD、SA、SD、SPD -“total_battle_stats”(数组 hp、pa、pd、sa、sd、spd)
总血压 - “total_bp”

该列表中player_ID之后的所有内容都是特定的。每个用户名有 6 个 mons，这意味着每个用户名有 6 行。 player_ID 之前的内容可以在第 1-6 行中重复，这并不重要。

Answer 1

您有一些混杂因素。

1) 每个玩家体内都嵌套有怪物。您需要考虑到这一点并复制这些行的初始行信息。

2) 由于您的 header ，您假设 json 结构是常规的，并且 json 中的每个对象中包含相同数量的项目/键。情况并非如此，例如 MonsterId 47023 只有一个 Type 值，并且没有 祖先。我使用一些硬编码值来根据 header 设置循环，即应该有 2 个类型值和 3 个祖先值。我将其包装在 On Error Resume Next On Error GoTo O 中，以在尝试访问不存在的项目时抑制由此产生的错误。这样就输入了一个空白。

异常值示例:

<小时/>

VBA:

Option Explicit   
Public Sub WriteOutBattleInfo()
    Dim headers(), json As Object, key As Variant, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    headers = Array("Username", "Avg BP", "Avg Level", "Opp. Address", "Player ID", "Catch Number", "Monster ID", "Type 1", "Type 2", "Gason Y/N", "Ancestor 1", "Ancestor 2", "Ancestor 3", "Class ID", "Total Level", "Exp", "HP", "PA", "PD", "SA", "SD", "SPD", "Total BP")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.etheremon.com/api/ema_battle/get_rank_castles?v=8588587&trainer_address=0x2fef65e4d69a38bf0dd074079f367cdf176ec0de", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)("data")("defender_list") 'Collection of dictionaries
    End With
    Dim dict As Object, c As Long, r As Long, item As Object, key2 As Variant, results(), item2 As Long
    ReDim results(1 To json.Count * json(1)("monster_info").Count, 1 To UBound(headers) + 1) '<== +1 here if can establish what catch number is

    Dim j As Long
    For Each dict In json
        r = r + 1: c = 1
        For Each key In dict.keys
            Select Case key
            Case "username", "avg_bp", "avg_level", "address", "player_id"
                results(r, c) = dict(key)
                c = c + 1
            Case "monster_info"
                Dim monsterNumber As Long, temp(1 To 5)
                monsterNumber = 1
                For Each item In dict(key)       'collection of dictionaries               
                    If monsterNumber = 1 Then
                        For j = 1 To 5
                            temp(j) = results(r, j)
                        Next
                    Else
                        r = r + 1
                        For j = 1 To 5
                            results(r, j) = temp(j)
                        Next
                    End If
                    For Each key2 In item.keys
                        Select Case key2
                        Case "create_index", "monster_id", "is_gason", "class_id", "total_level", "exp", "total_bp"
                            results(r, c) = item(key2)
                            c = c + 1
                            Case "types" '<==expecting 2. Can get 1. Maybe different count?
                            For item2 = 1 To 2
                                On Error Resume Next
                                results(r, c) = item(key2).item(item2)
                                c = c + 1
                                On Error GoTo 0
                            Next
                            Case "ancestors" '<== expecting 3. Can get 0. Maybe different number
                            For item2 = 1 To 3
                                On Error Resume Next
                                results(r, c) = item(key2).item(item2)
                                c = c + 1
                                On Error GoTo 0
                            Next
                            Case "battle_stats"
                            For item2 = 1 To item(key2).Count
                                results(r, c) = item(key2).item(item2)
                                c = c + 1
                            Next
                        End Select
                    Next
                    c = 6: monsterNumber = monsterNumber + 1
                Next item
            End Select
        Next
    Next
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

<小时/>

示例输出: