Я делаю запрос на веб-сайт и вставляю ответ 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

Код после ответа Qharr. Я получаю ошибку времени выполнения 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
0
Andrew Bishop 30 Ноя 2018 в 22:46

2 ответа

Лучший ответ

Я нашел решение для вставки текста ответа с помощью 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
0
Andrew Bishop 3 Дек 2018 в 15:40

Я не понимаю, что вы имеете в виду. Полный ответ может быть помещен в ячейку следующим образом. 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")

2
QHarr 30 Ноя 2018 в 20:42