Excel VBA JSON数组url导入和解析

Question

我尝试使用VBA将以下链接中的JSON数据导入并解析为excel：

https://www.alphavantage.co/query?fu...N5&symbol=MSFT

不幸的是，我无法完成它，因为它一直出错：对象不支持此属性或方法。有人可以帮我解决一下吗？

我所需要的只是使用为其提供的SMA获取列出的日期。 JSON文件的URL实际上在Sheet2中，并在代码中引用。原因是因为我将有多个URL，代码需要循环并导入。

这是预期输出的截图。

https://imgur.com/a/p2TKD

以下是我使用的代码：

＆＃13;

＆＃13;

Sub test()
Dim objHTTP As Object
Dim MyScript As Object
Dim x As Integer, NoA As Integer, NoC As Integer
Dim myData As Object
Set MyScript = CreateObject("MSScriptControl.ScriptControl")
MyScript.Language = "JScript"

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
For x = 1 To Application.CountA(Sheet2.Columns(1))
Sheets("Sheet1").Activate
Sheets(1).Cells.Clear
Sheets(1).Range("A1:D1").Font.Bold = True
Sheets(1).Range("A1:D1").Font.Color = vbRed
Sheets(1).Range("A1") = "DATE"
Sheets(1).Range("B1") = "SMA"

URL = Sheets(2).Cells(x, 1)
objHTTP.Open "GET", URL, False
objHTTP.Send

If objHTTP.ReadyState = 4 Then
If objHTTP.Status = 200 Then

Set RetVal = MyScript.Eval("(" & objHTTP.responseText & ")")
objHTTP.abort

Set MyList1 = RetVal.result.buy
NoA = Sheet1.Cells(65536, 1).End(xlUp).Row + 1

For Each myData In MyList1
Sheets(1).Cells(NoA, 1).Value = myData.Last_Refreshed
Sheets(1).Cells(NoA, 2).Value = myData.SMA
NoA = NoA + 1
Next
End If
End If

Next

Set MyList2 = Nothing
Set MyList = Nothing
Set objHTTP = Nothing
Set MyScript = Nothing
End Sub

＆＃13;

＆＃13;

＆＃13;

Answer 1

这样做。使用VBA JSON模块，您需要在vbe＆gt;中添加对microsoft scripting runtime的引用工具＆gt;参考

Option Explicit

Public Sub test()

    Dim objHTTP As Object
    Dim URL As String
    Dim Json As Object

    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

    URL = "https://www.alphavantage.co/query?function=SMA&interval=daily&time_period=90&series_type=close&apikey=ES1RXJ7VF1C1L9N5&symbol=MSFT"
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    objHTTP.Send

    Set Json = JsonConverter.ParseJson(objHTTP.ResponseText)("Technical Analysis: SMA")

    Dim key As Variant
    Dim counter As Long

    counter = 1

    For Each key In Json                         'loop items of collection which returns dictionaries of dictionaries

      Dim innerKey As Variant

      For Each innerKey In Json(key).Keys
          counter = counter + 1
         ActiveSheet.Cells(counter, 1) = key '
         ActiveSheet.Cells(counter, 2) = Json(key)(innerKey) ' innerKey
      Next innerKey

    Next key

End Sub

结果：

要测试网址列表以查看是否有效，请参阅@FlorentB此处的回答

Excel VBA script to find 404 errors in a list of URLs?