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

这是我正在使用的代码：

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

Answer 1

这样就可以了。使用VBA JSON 模块，您需要在 vbe > tools >references

中添加对microsoft scripting runtime 的引用

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

结果：

要测试 URL 列表以查看是否有效，请参阅@FlorentB 的答案

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