JSON not getting the collection of data in VBA Excel 2010

Question

I have started creating an excel for stock watch in 2010 and havent been able to parse properly.

Instead of getting the columns with [symbol] and prices i only get first four tags and nothing inside data.

This is the code:

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

Also as this is excel 2010 and doing it as a newbie let me know if this is the correct way to parse json as i am going to create multiple excels with different urls.

Answer 1

You need to inspect the JSON structure and write your code accordingly. The [] means collection which you can For Each over the items of. The {} means dictionary which you can loop over the keys of. The blue and green squares (in the image of your JSON below) are string literals (key,value pairs).

You initially get back a dictionary containing a mixture of key, value pairs (eg noChg , 5 ); with one key, data , being to a collection of inner dictionaries.

jsonObj("symbol") if you had parsed with ParseJson and following syntax:

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

would have failed as symbol is a key in the inner dictionaries, within the collection data , and not directly accessible from the initial top level JSON dictionary.

Instead, you need to loop the initial dictionary and write out the key, value pairs and test if the key is data . If the key is data , you instead need to loop the items in the collection (each being a dictionary), and loop the keys of those dictionaries.

A little thought as to how you increment row and column counters, and testing for the first time the inner dictionary keys are looped, to get the headers only once, will result in a tidy write out of data to sheet.

NOTE: I am using JSONConverter.bas to parse the JSON. After adding this to the project, I also go to VBE > Tools > References and add a reference to 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

---

Sample of data in sheet: