首页 > 解决方案 > JSON 未在 VBA Excel 2010 中收集数据

问题描述

我在 2010 年开始为股票手表创建 excel,但无法正确解析。

我没有得到带有 [symbol] 和价格的列,而是只得到前四个标签,没有任何内部数据。

这是代码:

Sub getJSON()
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json"
MyRequest.Send
MsgBox MyRequest.ResponseText

Dim jsonText As String
Dim jsonObj As Dictionary
Dim jsonRows As Collection
Dim jsonRow As Collection
Dim ws As Worksheet
Dim currentRow As Long
Dim startColumn As Long
Dim i As Long

Set ws = Worksheets("Sheet1")
ws.Range("A1") = MyRequest.ResponseText
MsgBox ws.Range("A1").Value

jsonText = ws.Range("A1").Value
'jsonText = MyRequest.ResponseText
'Parse it
Set jsonObj = JSON.parse(jsonText)

'Get the rows collection
'Error here'
Set jsonRows = jsonObj("symbol")

'Set the starting row where to put the values
currentRow = 1

'First column where to put the values
startColumn = 2 'B

'Loop through all the values received
For Each jsonRow In jsonRows
    'Now loop through all the items in this row
    For i = 1 To jsonRow.Count
        ws.Cells(currentRow, startColumn + i - 1).Value = jsonRow(i)
    Next i

    'Increment the row to the next one
    currentRow = currentRow + 1
    Next jsonRow
End Sub

同样因为这是 excel 2010 并且作为新手做它让我知道这是否是解析 json 的正确方法,因为我将创建具有不同 url 的多个 excel。

标签: jsonexcelvba

解决方案


您需要检查 JSON 结构并相应地编写代码。[]您可以For Each在其中的项目上收集的装置。{}您可以遍历其键的均值字典。蓝色和绿色方块(在下面的 JSON 图像中)是字符串文字(键、值对)。

你最初得到一个包含键值对混合的字典(例如noChg5);用一个键, data, 是一个内部字典的集合。

在此处输入图像描述

jsonObj("symbol")如果您使用ParseJson以下语法进行了解析:

Set jsonObj = JsonConverter.ParseJson(.responseText) '<== dictionary

会失败,因为symbol它是内部字典中的键,在 collectiondata中,并且不能从初始顶级 JSON 字典直接访问。

相反,您需要循环初始字典并写出键、值对并测试键是否为data. 如果键是data,则您需要循环集合中的项目(每个都是字典),并循环这些字典的键。

稍微考虑一下如何增加行和列计数器,并在第一次循环内部字典键时进行测试,以仅获取一次标题,这将导致将数据整齐地写入工作表。

注意:我使用JSONConverter.bas来解析 JSON。将此添加到项目后,我还转到 VBE > Tools > References 并添加对Microsoft Scripting Runtime的引用。


VBA:

Option Explicit
Public Sub GetInfo()
    Dim json As Object, item As Object, key As Variant, key2 As Variant, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        Set json = JsonConverter.ParseJson(.responseText) '<== dictionary
    End With

    Dim r As Long, c As Long, headerRow As Long
    For Each key In json '<== Loop initial dictionary
        r = r + 1          
        If key = "data" Then '<==collection of dictionaries
            For Each item In json("data")
                headerRow = headerRow + 1
                c = 1
                For Each key2 In item '<== individual dictionary
                    If headerRow = 1 Then '<==  test to write out headers of symbols info only once
                        ws.Cells(r, c) = key2
                        ws.Cells(r + 1, c) = item(key2)
                    Else
                        ws.Cells(r + 1, c) = item(key2)
                    End If
                    c = c + 1
                Next
                r = r + 1
            Next
        Else  'string literal key, value pairs 
            ws.Cells(r, 1) = key: ws.Cells(r, 2) = json(key)
        End If
    Next
End Sub

表格中的数据样本:

在此处输入图像描述


推荐阅读