VBA parse JSON to extract JSON response value

Short Way:

Short way might not work depending how complicated the JSON structure is.  No libraries need to be enabled for this script.

API Endpoint:  https://api.iextrading.com/1.0/stock/jnj/quote

Dim scriptcontrol, restext, jsonSrc As Variant
Set scriptcontrol = CreateObject("MSScriptControl.ScriptControl")
scriptcontrol.Language = "JScript"

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://api.iextrading.com/1.0/stock/jnj/quote", False
    restext = Replace(.responseText, "[", "")
    restext = Replace(restext, "]", "")

    Set jsonSrc = scriptcontrol.Eval("(" + restext + ")")
    MsgBox "Symbol: " & jsonSrc.symbol
    MsgBox "52 week low: " & jsonSrc.week52Low
    MsgBox "52 week high: " & jsonSrc.week52High
End With

Long Way:

VBA to parse JSON.  Extract values out of JSON response from API Call.  Uses VBA-JSON.

VBA-JSON bas file (681 downloads)
  1. Download the zip file and extract JsonConverter.bas.
  2. Then open your VBA editor window and go file -> import file -> select JsonConverter.bas.
  3. The JSON parsing code will be added to your modules.


Sub getData()
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", "https://jira.atlassian.com/rest/api/2/issue/JRA-9.json"
MsgBox MyRequest.responseText

Dim json As Object
Set json = JsonConverter.ParseJson(MyRequest.responseText)
MsgBox json("key")
MsgBox json("fields")("fixVersions")(1)("id")
End Sub


Add following libraries

Sub xmlHttp()
Const URl As String = "http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=ICICIBANK"
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")

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) & "}"
strDiv = Replace(strDiv, "{""data"":[", "")
strDiv = Replace(strDiv, "]}", "")
MsgBox strDiv
Cells(1, 1).Value = strDiv
Set json = JsonConverter.ParseJson(strDiv)
MsgBox json("symbol")

End Sub