Как получить ответ JSON с помощью VBA?

Question

Я отправляю запрос на веб-сайт и вставляю ответ JSON в одну ячейку.

Я получаю объект, требующий ошибку 424.

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

URL-адрес, который дает мне ответв ячейке "M24":

https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic

Код после ответа Кхарра.Я получаю ошибку времени выполнения 0, хотя ошибка говорит, что она прошла успешно.Ничего не копируется в мои клетки.

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

Я нашел решение для вставки текста ответа в Excel 2003. Ниже мой законченный код.

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

Answer 2

Мне не понятно, что вы имеете в виду.Весь ответ может идти в ячейке следующим образом.JSON - это объект, поэтому вам нужно ключевое слово Set, но вы не можете установить диапазон ячеек для объекта словаря - источника вашей ошибки.

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

Когда вы используете parsejson, вы конвертируете вобъект словаря, с которым вам нужно что-то делать.Внутри просто слишком много данных, чтобы что-то записать (если предел не превышен) в одну ячейку.

---

Внутренний словарь data быстро опускается во вложенные коллекции.Количество вложенных коллекций исходит из

Dim dict As Object
Set dict = json("response")("data")
Debug.Print "nested collection count = " & dict("sdSpectrum").Count + dict("smSpectrum").Count

Чтобы получить только значения s1 и ss, проанализируйте их:

Dim dict As Object
Set dict = json("response")("data")
ws.Cells(1, 2) = "ss: " & dict("ss") & Chr$(10) & "s1: " & dict("s1")