How to retrieve JSON response using VBA? - json

Question

I make a request to a website and paste the JSON response into a single cell.
I get an object required 424 error.
Sub GetJSON()
Dim hReq As Object
Dim JSON As Dictionary
Dim var As Variant
Dim ws As Worksheet
Set ws = Title
'create our URL string and pass the user entered information to it
Dim strUrl As String
strUrl = Range("M24").Value
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.Send
End With
'wrap the response in a JSON root tag "data" to count returned objects
Dim response As String
response = "{""data"":" & hReq.responseText & "}"
Set JSON = JsonConverter.ParseJson(response)
'set array size to accept all returned objects
ReDim var(JSON("data").Count, 1)
Cells(25, 13) = JSON
Erase var
Set var = Nothing
Set hReq = Nothing
Set JSON = Nothing
End Sub
The URL that gives me the response in cell "M24":
https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic
The code after Qharr's response. I get a run time 0 error even though the error says it ran successfully. Nothing is copied to my cells.
Public Sub GetInfo()
Dim URL As String, json As Object
Dim dict As Object
URL = "https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
Set json = JsonConverter.ParseJson(.responseText) '<== dictionary
ThisWorkbook.Worksheets("Title").Cells(1, 1) = .responseText
Set dict = json("response")("data")
ws.Cells(13, 27) = "ss: " & dict("ss") & Chr$(10) & "s1: " & dict("s1")
End With
End Sub

Answer 1

I'm not clear what you mean. The entire response can go in a cell as follows.
JSON is an object so you would need Set keyword but you can't set a cell range to the dictionary object - the source of your error.
Option Explicit
Public Sub GetInfo()
Dim URL As String, json As Object
URL = "https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
Set json = JsonConverter.ParseJson(.responseText) '<== dictionary
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = .responseText
End With
End Sub
When you use parsejson you are converting to a dictionary object which you need to do something with. There is simply too much data nested inside to write anything readable (if limit not exceeded) into one cell.
Inner dictionary data quickly descends into nested collections. The nested collection count comes from
Dim dict As Object
Set dict = json("response")("data")
Debug.Print "nested collection count = " & dict("sdSpectrum").Count + dict("smSpectrum").Count
To get just s1 and ss values parse them out:
Dim dict As Object
Set dict = json("response")("data")
ws.Cells(1, 2) = "ss: " & dict("ss") & Chr$(10) & "s1: " & dict("s1")

Answer 2

I have figured out the solution to pasting the response text with Excel 2003. Below is my finished code.
Public Sub datagrab()
Dim URL As String
Dim ws As Object
Dim xmlhttp As New MSXML2.XMLHTTP60
URL = Range("M24").Value 'This is the URL I'm requesting from
xmlhttp.Open "GET", URL, False
xmlhttp.Send
Worksheets("Title").Range("M25").Value = xmlhttp.responseText
End Sub