如何使用VBA檢索JSON響應？

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

在單元格“ M24”中給我響應的URL：

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

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

Answer 1

我不清楚你的意思。 整個響應可以按如下方式進入單元格。 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")

Answer 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