JSON не получает сбор данных в VBA Excel 2010

Question

Я начал создавать Excel для фондовых часов в 2010 году и не смог разобрать должным образом.

Вместо того, чтобы получать столбцы с [символом] и ценами, я получаю только первые четыре тега и ничего внутри данных.

Это код:

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.

Answer 1

Вам нужно проверить структуру JSON и написать свой код соответственно.[] означает коллекцию, которую вы можете For Each над предметами.{} означает словарь, который вы можете циклически переключать по клавишам.Синие и зеленые квадраты (на изображении вашего JSON ниже) являются строковыми литералами (ключ, пары значений).

Сначала вы получаете словарь, содержащий смесь пар ключ-значение (например, noChg,5);с одним ключом data, находящимся в наборе внутренних словарей.

jsonObj("symbol"), если вы проанализировали с ParseJson и следующиеСинтаксис:

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

не удалось бы, так как symbol является ключом во внутренних словарях в коллекции data и не доступен напрямую из исходного словаря JSON верхнего уровня.

Вместо этого вам нужно зациклить начальный словарь и выписать ключ, пары значений и проверить, является ли ключ data.Если ключ data, вам вместо этого нужно зациклить элементы в коллекции (каждый из которых является словарем) и зациклить ключи этих словарей.

Немного подумал о том, как увеличивать счетчики строк и столбцов, и при первом тестировании внутренних ключей словаря зацикливаться, чтобы получить заголовки только один раз, приведет к аккуратной записи данных на лист.

ПРИМЕЧАНИЕ: Я использую JSONConverter.bas для анализа JSON.После добавления этого в проект я также захожу в VBE> Инструменты> Ссылки и добавляю ссылку на 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

---

Образец данных в листе: