How to retrieve JSON response using VBA?

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

Do you need to transfer JSON to an array (you seem to Redim var, as if you're about to do just that), then transfer that array to worksheet. Also, it's better to specify the workbook and worksheet name. Something like: Thisworkbook.worksheets("Sheet1").cells(24, "M").resize(ubound(var,1), ubound(var,2)).value2 = var — chillin
– chillin, Commented Nov 30, 2018 at 19:55
I am not familiar with the JsonConverter class' implementation, maybe it has a member/method that will dump the JSON contents to a range (without creating an interim array var). What you can't do is assign JSON to a range, as JSON is an object returned by ParseJson. Hope that makes sense. — chillin
– chillin, Commented Nov 30, 2018 at 19:59
What do you mean by the entire response in a single cell? The JSON string? — QHarr
– QHarr, Commented Nov 30, 2018 at 20:16

QHarr · Accepted Answer · 2018-11-30 20:42:34Z

4

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")

edited Nov 30, 2018 at 20:42

answered Nov 30, 2018 at 20:22

QHarr

84.5k14 gold badges58 silver badges105 bronze badges

Sign up to request clarification or add additional context in comments.

13 Comments

Andrew Bishop Over a year ago

I do need the entire JSON string to be copied into a single cell. Realistically, I was going to use that string and just use a formula to search it for the "ss" and "s1" values that you see in the response if you load the actual web page.

Automate This Over a year ago

Good point about cell limit, the response given is already 31,309 of the 32,767 characters in a cell limit.

QHarr Over a year ago

Why not parse the JSON for the ss and s1 values? I have added an edit showing this.

Andrew Bishop Over a year ago

Parsing for those values is actually ideal, I just didn't know how to do it. My code below says it completed successfully, but it also gives me a run-time error 0 and does nothing.

Andrew Bishop Over a year ago

Public Sub GetInfo() Dim URL As String, json As Object Dim dict As Object URL = "earthquake.usgs.gov/ws/designmaps/…" 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

|

Andrew Bishop · Accepted Answer · 2018-12-03 15:40:57Z

0

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

answered Dec 3, 2018 at 15:40

Andrew Bishop

372 silver badges8 bronze badges

1 Comment

QHarr Over a year ago

I already showed this answer in my answer where I wrote ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = .responseText And MSXML2.XMLHTTP60 is not for Excel 2003 I believe.

Collectives™ on Stack Overflow

How to retrieve JSON response using VBA?

2 Answers 2

13 Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

13 Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related