This is my first attempt to extract web content. I found a similar post at VBA Macro to extract JSON data and post into cells with a response from Haluk. I can get the code to work on the original web content page but I cannot get it to work on the page I am interested in extracting data from (e.g., https://query1.finance.yahoo.com/v7...l=15m&indicators=quote&includeTimestamps=true). When I run the code below, I get a run-time error 438: object doesn't support this property or method at Set=NewMyList = NewRetVal.Data. I am assuming it is because the format of the data is slightly different but I don't know how to change it.
I don't need the data that has problems with reserved words, but I am curious if there is a way to still extract that data.
I don't need the data that has problems with reserved words, but I am curious if there is a way to still extract that data.
VBA Code:
Sub Test4() ' modified code from Haluk on mrexcel.com
Dim objHTTP As Object
Dim NewobjHTTP As Object
Dim MyScript As Object
Dim NewMyScript As Object
Dim i As Long
Dim myData As Object
Dim NewmyData As Object
Set MyScript = CreateObject("MSScriptControl.ScriptControl")
MyScript.Language = "JScript"
Url = "https://min-api.cryptocompare.com/data/histominute?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG"
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "GET", Url, False
objHTTP.send
Set RetVal = MyScript.Eval("(" + objHTTP.responsetext + ")")
objHTTP.abort
i = 2
Set MyList = RetVal.Data
For Each myData In MyList
' Cells(i, 1).Value = myData.Time
' Cells(i, 2).Value = myData.Close
Cells(i, 3).Value = myData.high
Cells(i, 4).Value = myData.low
' Cells(i, 5).Value = myData.Open
Cells(i, 6).Value = myData.volumefrom
Cells(i, 7).Value = myData.volumeto
i = i + 1
Next
' attempting a different page
Set NewMyScript = CreateObject("MSScriptControl.ScriptControl")
NewMyScript.Language = "JScript"
NewUrl = "https://query1.finance.yahoo.com/v7/finance/chart/DXCM?range=1d&interval=15m&indicators=quote&includeTimestamps=true"
Set NewobjHTTP = CreateObject("MSXML2.XMLHTTP")
NewobjHTTP.Open "GET", NewUrl, False
NewobjHTTP.send
Set NewRetVal = MyScript.Eval("(" + NewobjHTTP.responsetext + ")")
NewobjHTTP.abort
i = 2
Set NewMyList = NewRetVal.Data
For Each NewmyData In NewMyList
Cells(i, 11).Value = NewmyData.timestamp
Cells(i, 12).Value = NewmyData.low
Cells(i, 13).Value = NewmyData.volume
' Cells(i, 14).Value = NewmyData.Open
' Cells(i, 15).Value = NewmyData.Close
Cells(i, 16).Value = NewmyData.high
i = i + 1
Next
Set NewMyList = Nothing
Set NewobjHTTP = Nothing
Set NewMyScript = Nothing
End Sub