Question

我正在尝试使用以下代码将JSON数据作为表提取到Excel工作表中。

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

    sURL = "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json"

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

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

    i = 2

    For Each sItem In oJSON
        dItemString = oJSON(sItem)("symbol")
        sItemValue = oJSON(sItem)("open")
        vItemValue = oJSON(sItem)("high")
        xItemValue = oJSON(sItem)("low")
        Cells(i, 1) = dItemString
        Cells(i, 2) = sItemValue
        Cells(i, 3) = vItemValue
        Cells(i, 4) = xItemValue
        i = i + 1
    Next
End Sub

但是，出现以下错误！

为什么会出现此错误？请告知

Answer 1

首先，您需要使用任何在线JSON查看器（例如http://jsonviewer.stack.hu/）检查JSON响应的结构，在其中您可以看到JSON对象包含data数组和几个属性标量值：

更进一步，data数组中有一些对象，每个对象都包含一些可以填充到工作表上的行中的属性：

这是VBA示例，显示了如何检索这些值。 将JSON.bas模块导入VBA项目中以进行JSON处理。

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult

    ' Retrieve JSON content
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json", True
        .send
        Do Until .readyState = 4: DoEvents: Loop
        sJSONString = .responseText
    End With
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then MsgBox "Invalid JSON": End
    ' Convert raw JSON to 2d array and output to worksheet #1
    JSON.ToArray vJSON("data"), aData, aHeader
    With ThisWorkbook.Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

data数组对我的输出如下：

顺便说一句，类似的方法适用于in other answers。

Answer 2

我将您的代码粘贴到测试模块中，然后将JsonConverter作为其他模块导入到我的空工作簿中。您收到的错误很可能是因为您需要在工作簿中添加“ Microsoft Scripting Runtime”库。在VBE中，转到“工具”->“参考...”菜单，然后向下滚动并在库旁边放置一个复选标记。完成此操作后，您的代码可以毫无问题地解析JSON。

但是它确实在您的循环中失败了。

我高度建议您在模块顶部使用Option Explicit。您认为您正在使用的变量类型（因为我看到您正在尝试使用匈牙利表示法）不一定是实际数据的类型。我的建议是对变量使用描述性名称，以避免混淆。另外，您应该循环使用oJSON("data")结构（顺便说一下，这是Collection）。这是我付诸实践的建议：

Option Explicit

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

    Dim sURL As String
    sURL = "https://www.nseindia.com/live_market/dynaContent/" & _
           "live_watch/stock_watch/foSecStockWatch.json"

    Dim sRequest As String
    sRequest = sURL
    httpObject.Open "GET", sRequest, False
    httpObject.send

    Dim sGetResult As String
    sGetResult = httpObject.responseText

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

    Dim i As Long
    i = 2

    Dim dataItem As Variant
    Dim symbolName As String
    Dim openValue As Double
    Dim highValue As Double
    Dim lowValue As Variant
    For Each dataItem In oJSON("data")
        symbolName = dataItem("symbol")
        openValue = dataItem("open")
        highValue = dataItem("high")
        lowValue = dataItem("low")
        Cells(i, 1) = symbolName
        Cells(i, 2) = openValue
        Cells(i, 3) = highValue
        Cells(i, 4) = lowValue
        i = i + 1
    Next
End Sub

将JSON数据解析为Excel工作表

2 个答案: