Santhosh Santhosh - 1 year ago 490
JSON Question

Handle JSON Object in XMLHttp response in Excel VBA Code

I am need of handling JSON Object which is the response of XMLHTTPRequest in Excel VBA. I wrote below code but not succeeded. Please guide me.

Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"

Dim strURL As String: strURL = "blah blah"

Dim strRequest
Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp")
Dim response As String

XMLhttp.Open "POST", strURL, False
XMLhttp.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
XMLhttp.send strRequest
response = XMLhttp.responseText
sc.Eval ("JSON.parse('" + response + "')")

I am getting the error Run-time error '429' ActiveX component can't create object in the line
Set sc = CreateObject("ScriptControl")

And, Once we parsed the JOSN Object, how to access the values of JSON Object?

P.S. My JSON Object sample:
{"Success":true,"Message":"Blah blah"}

Answer Source

The code gets the data from nseindia site which comes as a JSON string in responseDiv element.

Required References

enter image description here

3 Class Module i have used

  • cJSONScript
  • cStringBuilder
  • JSON

(I have picked these class modules from here)

You may download the file from this link

Standard Module

Const URl As String = ""
Sub xmlHttp()

    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xmlHttp.Open "GET", URl & "&rnd=" & WorksheetFunction.RandBetween(1, 99), False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"

    Dim html As MSHTML.HTMLDocument
    Set html = New MSHTML.HTMLDocument
    html.body.innerHTML = xmlHttp.ResponseText

    Dim divData As Object
    Set divData = html.getElementById("responseDiv")
    ' Here you will get a string which is a JSON data

    Dim strDiv As String, startVal As Long, endVal As Long
    strDiv = divData.innerHTML
    startVal = InStr(1, strDiv, "data", vbTextCompare)
    endVal = InStr(startVal, strDiv, "]", vbTextCompare)
    strDiv = "{" & Mid(strDiv, startVal - 1, (endVal - startVal) + 2) & "}"

    Dim JSON As New JSON

    Dim p As Object
    Set p = JSON.parse(strDiv)

    i = 1
    For Each item In p("data")(1)
       Cells(i, 1) = item
       Cells(i, 2) = p("data")(1)(item)
        i = i + 1

 End Sub
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download