如何修复 XML HTTP 请求中的“下标超出范围”错误

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

Answer 2

您应该检查一个节点是否存在，查看（转换后的）XML，您会发现availableToBack 和availabletoLay 并不总是存在。

“Kent v Essex”下只有 1 个availableToLay，而availableToBack：

<eventNodes>
  <eventId>29417978</eventId>
  <event>
    <eventName>Kent v Essex</eventName>
    <countryCode>GB</countryCode>
    <timezone>GMT</timezone>
    <openDate>2019-08-18T10:00:00Z</openDate>
  </event>
  <marketNodes>
    <marketId>1.161362186</marketId>
    <isMarketDataDelayed>true</isMarketDataDelayed>
    <state>
      <betDelay>0</betDelay>
      <bspReconciled>false</bspReconciled>
      <complete>true</complete>
      <inplay>false</inplay>
      <numberOfWinners>1</numberOfWinners>
      <numberOfRunners>3</numberOfRunners>
      <numberOfActiveRunners>3</numberOfActiveRunners>
      <totalMatched>0</totalMatched>
      <totalAvailable>14844.762771507034</totalAvailable>
      <crossMatching>true</crossMatching>
      <runnersVoidable>false</runnersVoidable>
      <version>2893531625</version>
      <status>OPEN</status>
    </state>
    <runners>
      <selectionId>5901</selectionId>
      <handicap>0</handicap>
      <description>
        <runnerName>Kent</runnerName>
      </description>
      <state>
        <sortPriority>1</sortPriority>
        <totalMatched>0</totalMatched>
        <status>ACTIVE</status>
      </state>
      <exchange>
        <availableToBack>
          <price>1.42</price>
          <size>56.84</size>
        </availableToBack>
        <availableToBack>
          <price>1.1</price>
          <size>13.6</size>
        </availableToBack>
        <availableToLay>
          <price>100</price>
          <size>8.51</size>
        </availableToLay>
      </exchange>
    </runners>

这可以这样完成： （请注意，我不经常在 Excel 中做这种事情，所以可能有“更聪明”的方法来做这件事......?）

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")
Dim obj0 As Object

ReDim results(1 To runners.Count, 1 To 7)
intEventNode = 1
For Each eventNode In runners
    r = r + 1

    Name = eventNode("event")("eventName")
    If eventNode.Exists("marketNodes") Then
        intMarketNode = 1
        For Each marketNode In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")
            If marketNode.Exists("runners") Then
                intRunner = 1
                For Each runner In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")(intMarketNode)("runners")
                    If runner.Exists("exchange") Then
                        runnerName = runner("description")("runnerName")
                        For Each ex In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")(intMarketNode)("runners")(intRunner)("exchange")("availableToBack")
                            If ex.Exists("price") Then
                                    'MsgBox "name: " + Name + Chr$(13) + "runnerName: " + runnerName + Chr$(13) + "availableToBack: " + CStr(ex("price"))
                                    Cells(r, 1) = Name
                                    Cells(r, 2) = runnerName
                                    Cells(r, 3) = "availableToBack"
                                    Cells(r, 4) = ex("price")
                                    Cells(r, 5) = ex("size")
                                    r = r + 1
                            End If
                        Next
                        For Each ex In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")(intMarketNode)("runners")(intRunner)("exchange")("availableToLay")
                            If ex.Exists("price") Then
                                    'MsgBox "name: " + Name + Chr$(13) + "runnerName: " + runnerName + Chr$(13) + "availableToLay: " + CStr(ex("price"))
                                    Cells(r, 1) = Name
                                    Cells(r, 2) = runnerName
                                    Cells(r, 3) = "availableToLay"
                                    Cells(r, 4) = ex("price")
                                    Cells(r, 5) = ex("size")
                                    r = r + 1

                            End If
                        Next
                    End If
                    intRunner = intRunner + 1
                Next
            End If
            intMarketNode = intMarketNode + 1
        Next
        intEventNode = intEventNode + 1
    End If
Next