json - 如何修复 XML HTTP 请求中的 "Subscript out of range"错误

Question

我有一个工作正常的代码，但在下面代码的注释行中触发错误“下标超出范围”。

我在线使用了json格式化程序查看了XML结构，我似乎没有看到触发错误的原因。现在，如果我注释掉最后两个节点，代码就可以正常工作。我使用的代码可以引用这里 - Extracting HTML elements values using their classes

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.betfair.com/www/sports/exchange/readonly/v1/bymarket?_ak=nzIFcwyWhrlwYMrh&alt=json&currencyCode=USD&locale=en&marketIds=1.161189078,1.161073119,1.161362337,1.161362195,1.161362198,1.161362200,1.161362186,1.161362202,1.161362187,1.161362205,1.161362188,1.161362189,1.161425408&rollupLimit=25&rollupModel=STAKE&types=MARKET_STATE,%20EVENT,RUNNER_DESCRIPTION,RUNNER_STATE,RUNNER_EXCHANGE_PRICES_BEST", False
    .send
    s = .responseText
    Set json = JsonConverter.ParseJson(s)
End With

Dim runners As Object, runner As Object, results(), r As Variant
Set runners = json("eventTypes")(1)("eventNodes")

ReDim results(1 To runners.Count, 1 To 7)
For Each runner In runners
    r = r + 1
    results(r, 1) = runner("event")("eventName")
    results(r, 2) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToBack")(1)("price")
    results(r, 3) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToLay")(1)("price")
    results(r, 4) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToBack")(1)("price")
    results(r, 5) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToLay")(1)("price")
    ''results(r, 6) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToBack")(1)("price")
    ''results(r, 7) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToLay")(1)("price")
Next

我需要帮助来修复该错误并使所有节点正常工作。

Answer 1

您的错误来自尝试访问 runners 中超出范围(太高)的索引收藏。当您到达索引 11(根据 VBA JSON 集合，基于 0 - 或基于 1 时为 12)时，runners 中只有两个项目，而不是 3。收藏。我通常用 On Error Resume Next On Error GoTo 0 处理这个问题。围绕填充数组的行进行包装 - 这会为丢失的项目留下空白。到目前为止，当您知道要填充的数组的尺寸并且只需要处理一些不存在的项目时，我的偏好是。



VBA:

Option Explicit

Public Sub WriteOutResults()
    Dim s As String, json As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.betfair.com/www/sports/exchange/readonly/v1/bymarket?_ak=nzIFcwyWhrlwYMrh&alt=json&currencyCode=USD&locale=en&marketIds=1.161189078,1.161073119,1.161362337,1.161362195,1.161362198,1.161362200,1.161362186,1.161362202,1.161362187,1.161362205,1.161362188,1.161362189,1.161425408&rollupLimit=25&rollupModel=STAKE&types=MARKET_STATE,%20EVENT,RUNNER_DESCRIPTION,RUNNER_STATE,RUNNER_EXCHANGE_PRICES_BEST", False
        .send
        s = .responseText
        Set json = JsonConverter.ParseJson(s)
    End With

    Dim runners As Object, runner As Object, results(), r As Variant
    Set runners = json("eventTypes")(1)("eventNodes")

    ReDim results(1 To runners.Count, 1 To 7)
    For Each runner In runners
        r = r + 1
        On Error Resume Next
        results(r, 1) = runner("event")("eventName")
        results(r, 2) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToBack")(1)("price")
        results(r, 3) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToLay")(1)("price")
        results(r, 4) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToBack")(1)("price")
        results(r, 5) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToLay")(1)("price")
        results(r, 6) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToBack")(1)("price")
        results(r, 7) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToLay")(1)("price")
        On Error GoTo 0
    Next
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub