Error while Parsing the JSON form www.niftyindices.com

Swat
January 21, 2025
84 views
0 votes
2 Answers

I used to use the following VBA code to parse data.

However, now the JSON parser is giving the following error.

I use the following VBA code.

Option Explicit

Sub nse()
Dim req As New MSXML2.XMLHTTP60
Dim url As String, defaultPayload As String, requestPayload As String, results() As String
Dim payloadJSON As Object, responseJSON As Object, item As Object
Dim startD As Date, endD As Date
Dim key As Variant
Dim i As Long, j As Long
Dim rng As Range

startD = "01/02/2020" 'Start date
endD = "29/02/2020" 'end date
url = "https://www.niftyindices.com/Backpage.aspx/getHistoricaldatatabletoString"
defaultPayload = "{'name':'NIFTY 50','startDate':'','endDate':''}"
Set rng = ThisWorkbook.Worksheets("NSE").Range("A2") 'Output worksheet name.


Set payloadJSON = JsonConverter.ParseJson(defaultPayload)
payloadJSON("startDate") = Day(startD) & "-" & MonthName(Month(startD), True) & "-" & Year(startD) '01-Feb-2020
payloadJSON("endDate") = Day(endD) & "-" & MonthName(Month(endD), True) & "-" & Year(endD) '29-Feb-2020
requestPayload = JsonConverter.ConvertToJson(payloadJSON)

With req
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
    .setRequestHeader "X-Requested-With", "XMLHttpRequest"
    .send requestPayload
    Set responseJSON = JsonConverter.ParseJson(.responseText)
End With
Debug.Print responseJSON("d")
Set responseJSON = JsonConverter.ParseJson(responseJSON("d"))
ReDim results(1 To responseJSON.Count, 1 To 7)
i = 0
For Each item In responseJSON
    i = i + 1
    j = 0
    For Each key In item
        j = j + 1
        results(i, j) = item(key)
    Next key
Next item
rng.Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

I understand the the Error is in Json Parser.
I am not able to decode the error.
Thanks in Advance…

Answers

You’re not properly constructing the payload for the POST. It should look like this:

{"cinfo":"{"name":"NIFTY 50","indexName":"NIFTY 50","startDate":"02-Jan-2020","endDate":"29-Feb-2020"}"}

Note that the value for the key cinfo is itself a JSON string (not a nested JSON object!) so it needs the proper escaping…

Revised and working for me:

Sub nse()
    Const URL As String = "https://www.niftyindices.com/Backpage.aspx/getHistoricaldatatabletoString"
    Dim req As New MSXML2.XMLHTTP60
    Dim requestPayload As String, results() As String
    Dim responseJSON As Object, item As Object
    Dim startD As Date, endD As Date, dict As Object, dict2 As Object
    Dim key As Variant
    Dim i As Long, j As Long
    Dim rng As Range
    
    startD = "01/02/2020" 'Start date
    endD = "29/02/2020" 'end date
    
    'construct the payload for the POST
    Set dict = CreateObject("scripting.dictionary")
    dict("name") = "NIFTY 50"
    dict("indexName") = "NIFTY 50"
    dict("startDate") = Format(startD, "dd-mmm-yyyy") '01-Feb-2020
    dict("endDate") = Format(endD, "dd-mmm-yyyy") '29-Feb-2020
    
    Set dict2 = CreateObject("scripting.dictionary")
    dict2("cinfo") = JsonConverter.ConvertToJson(dict)
    requestPayload = JsonConverter.ConvertToJson(dict2) '<<<<<<
    
    Debug.Print requestPayload
    
    With req
        .Open "POST", URL, False
        .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .setRequestHeader "X-Requested-With", "XMLHttpRequest"
        .send requestPayload
        Set responseJSON = JsonConverter.ParseJson(.responseText)
    End With
    
    Debug.Print responseJSON("d")
    Set responseJSON = JsonConverter.ParseJson(responseJSON("d"))
    ReDim results(1 To responseJSON.count, 1 To 8) '<< not 7
    i = 0
    For Each item In responseJSON
        i = i + 1
        j = 0
        For Each key In item.Keys
            j = j + 1
            results(i, j) = item(key)
        Next key
    Next item
    Set rng = ThisWorkbook.Worksheets("NSE").Range("A2") 'Output worksheet name.
    rng.Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

An alternative similar to Tim Williams’ answer is;

Sub Test()
    Dim objHTTP As Object
    Dim URL As String, strPayload As String
    Dim responseJSON As Object, objData As Object, item As Object
    Dim dict As Object, dict2 As Object, i As Long

    Range("A1:E" & rows.Count) = ""
    Range("A1:E1") = Array("Date", "Open", "High", "Low", "Close")
    
    URL = "https://www.niftyindices.com/Backpage.aspx/getHistoricaldatatabletoString"
    
    Set dict = CreateObject("Scripting.Dictionary")
    dict("name") = "NIFTY 50"
    dict("indexName") = "NIFTY 50"
    dict("startDate") = "01-Feb-2020"
    dict("endDate") = "29-Feb-2020"
    
    Set dict2 = CreateObject("scripting.dictionary")
    dict2("cinfo") = JsonConverter.ConvertToJson(dict)
    
    strPayload = JsonConverter.ConvertToJson(dict2)
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    With objHTTP
        .Open "POST", URL, False
        .setRequestHeader "Content-Type", "application/json"
        .send strPayload
        Set responseJSON = JsonConverter.ParseJson(.responseText)
    End With
    
    Set objData = JsonConverter.ParseJson(responseJSON("d"))
    
    i = 1
    
    For Each item In objData
        i = i + 1
        Range("A" & i) = item("HistoricalDate")
        Range("B" & i) = item("OPEN")
        Range("C" & i) = item("HIGH")
        Range("D" & i) = item("LOW")
        Range("E" & i) = item("CLOSE")
    Next
End Sub

Please signup or login to give your own answer.

Click here to cancel reply.