This will return you dana in C column.
Sub PRICEINCR()
Dim objHTTP As Object
Dim MyScript As Object
Dim myData As Variant
Dim myLength As Integer
Dim NoA As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
'Clean the ws
ws1.Cells.Clear
ws1.Activate
'Write labels of the key in the table to the ws
ws1.Range("B1") = "time"
ws1.Range("C1") = "close"
ws1.Range("D1") = "high"
ws1.Range("E1") = "low"
ws1.Range("F1") = "open"
ws1.Range("G1") = "volumefrom"
ws1.Range("H1") = "volumeto"
ws1.Range("B1:H1, J1:J2").Font.Bold = True
ws1.Range("B1:H1, J1:J2").Font.Color = vbRed
'The returned JSon table contents have the primary key/label named as "Data"
'We are going to refer this "Data" in the following two JScripts "getValue" and "getLength"
Set MyScript = CreateObject("MSScriptControl.ScriptControl")
MyScript.Language = "JScript"
MyScript.AddCode "function getValue(JSonList, JItem, JSonProperty) { return JSonList.Data[JItem][JSonProperty]; }"
MyScript.AddCode "function getLength(JSonList) { return JSonList.Data.length; }"
For x = 1 To Application.CountA(ws2.Columns(1))
On Error Resume Next
Url = ws2.Cells(x, 1)
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "GET", Url, False
objHTTP.Send
ws2.Cells(x, 3).Value = objHTTP.ResponseText
'Get the JSon table
Set RetVal = MyScript.Eval("(" & objHTTP.ResponseText & ")")
objHTTP.abort
'Retrieve the value of the key "close" in the 4th item of the data set "Data"
'with the help of the JScript function "getValue" above
myData = MyScript.Run("getValue", RetVal, 4, "close")
myLength = MyScript.Run("getLength", RetVal)
'Get all the values of the JSon table under "Data"
For i = 0 To myLength - 1
NoA = ws1.Cells(65536, 1).End(xlUp).Row + 1
ws1.Range("A" & NoA) = "Data -" & i
ws1.Range("B" & NoA) = MyScript.Run("getValue", RetVal, i, "time") / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
ws1.Range("C" & NoA) = MyScript.Run("getValue", RetVal, i, "close")
ws1.Range("D" & NoA) = MyScript.Run("getValue", RetVal, i, "high")
ws1.Range("E" & NoA) = MyScript.Run("getValue", RetVal, i, "low")
ws1.Range("F" & NoA) = MyScript.Run("getValue", RetVal, i, "open")
ws1.Range("G" & NoA) = MyScript.Run("getValue", RetVal, i, "volumefrom")
ws1.Range("H" & NoA) = MyScript.Run("getValue", RetVal, i, "volumeto")
Next
'Get the time info given in the JSon table
ws1.Range("J" & NoA) = "TimeFrom:"
ws1.Range("J" & NoA + 1) = "TimeTo:"
ws1.Range("K" & NoA) = RetVal.TimeFrom / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
ws1.Range("K" & NoA + 1) = RetVal.TimeTo / (CDbl(60) * CDbl(60) * CDbl(24)) + #1/1/1970#
Next
Set objHTTP = Nothing
Set MyScript = Nothing
End Sub
Bookmarks