Excel VBA JSON array url import and parse

[yousufj56]

Hi everyone,

I'm trying to import and parse the JSON data from the following link into excel using VBA:

https://www.alphavantage.co/query?f...ype=close&apikey=ES1RXJ7VF1C1L9N5&symbol=MSFT

Unfortunately, i'm not able to complete it as it keeps giving an error: Object doesn't support this property or method. Can someone please help me resolve?

All i need is to get the date that is listed a long with the SMA that is provided for it. The URL for the JSON file is actually in Sheet2 and is referenced in the code. The reason for this is because i will have multiple URLs that the code will need to loop through and import.

Here is a screenshot of expected out put.

https://imgur.com/a/p2TKD

Here is the code that i'm using:

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

 

[John_w]

This code extracts the dates and SMA values for one URL, so you'll need to adapt it to loop through multiple URLs.

Option Explicit

Public Sub Extract_JSON_Data2()

    Dim script As Object
    Dim HTTPobj As Object
    Dim URL As String
    Dim JSONobj As Object
    Dim SMAlist As Object
    Dim dateKeysObj As Object
    Dim dateKeys As Variant, dateKey As Variant
    Dim dateItem As Object
    Dim destCell As Range, r As Long
    
    With Worksheets("Sheet1")
        .Cells.ClearContents
        .Range("A1:B1").Value = Array("Date", "SMA")
        Set destCell = .Range("A2")
    End With
    
    Set script = CreateObject("MSScriptControl.ScriptControl")
    script.Language = "JScript"
    script.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; }"
    script.AddCode "function getItemByKey(jsonObj, key) { return jsonObj[key]; }"
    
    URL = "https://www.alphavantage.co/query?function=SMA&interval=daily&time_period=90&series_type=close&apikey=ES1RXJ7VF1C1L9N5&symbol=MSFT"
    
    Set JSONobj = Nothing
    Set HTTPobj = CreateObject("MSXML2.XMLHTTP")
    With HTTPobj
        .Open "GET", URL, False
        .Send
        If .Status = 200 Then
            Set JSONobj = script.Eval("(" & .responseText & ")")
        End If
    End With
    
    If Not JSONobj Is Nothing Then
    
        'Debug.Print JSONobj.hasOwnProperty("Technical Analysis: SMA")
        Set SMAlist = VBA.CallByName(JSONobj, "Technical Analysis: SMA", VbGet)
        
        Set dateKeysObj = script.Run("getKeys", SMAlist)
        r = 0
        For Each dateKey In dateKeysObj
            Set dateItem = VBA.CallByName(SMAlist, dateKey, VbGet)
            destCell.Offset(r, 0).Value = dateKey
            destCell.Offset(r, 1).Value = VBA.CallByName(dateItem, "SMA", VbGet)
            r = r + 1
        Next
    End If
        
End Sub

 

[yousufj56]

Awesome, that worked. If i have a list of URLs and some of them cause errors, is there a way i first run a macro to show me which URLs cause an error?

Or even if we can just print out "ERROR" onto Cells A1 and B1, that would work for me too.

 

[John_w]

You could write some code which checked for http status <> 200.