Excel VBA JSON array url import and parse

yousufj56

Board Regular
Joined
May 22, 2014
Messages
51
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:

Code:
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
 
Last edited:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
This code extracts the dates and SMA values for one URL, so you'll need to adapt it to loop through multiple URLs.
Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top