Get data from json array with in array? - arrays
I have a json like with this format
[{"ts_id": "96643010","rows": "64","columns":"Timestamp,Value", "data": [["2021-09-01T11:00:00.000+07:00",206.95],["2021-09-01T12:00:00.000+07:00",206.96],["2021-09-01T13:00:00.000+07:00",206.97],["2021-09-01T14:00:00.000+07:00",206.95],["2021-09-01T15:00:00.000+07:00",206.92],["2021-09-01T16:00:00.000+07:00",206.89],["2021-09-01T17:00:00.000+07:00",206.86],["2021-09-01T18:00:00.000+07:00",206.83],["2021-09-01T19:00:00.000+07:00",206.80],["2021-09-01T20:00:00.000+07:00",206.77],["2021-09-01T21:00:00.000+07:00",206.74],["2021-09-01T22:00:00.000+07:00",206.71],["2021-09-01T23:00:00.000+07:00",206.68],["2021-09-02T00:00:00.000+07:00",206.65],["2021-09-02T01:00:00.000+07:00",206.63],["2021-09-02T02:00:00.000+07:00",206.65],["2021-09-02T03:00:00.000+07:00",206.67],["2021-09-02T04:00:00.000+07:00",206.69],["2021-09-02T05:00:00.000+07:00",206.71],["2021-09-02T06:00:00.000+07:00",206.73],["2021-09-02T07:00:00.000+07:00",206.75],["2021-09-02T08:00:00.000+07:00",206.76],["2021-09-02T09:00:00.000+07:00",206.77],["2021-09-02T10:00:00.000+07:00",206.78],["2021-09-02T11:00:00.000+07:00",206.79],["2021-09-02T12:00:00.000+07:00",206.80],["2021-09-02T13:00:00.000+07:00",206.81],["2021-09-02T14:00:00.000+07:00",206.82],["2021-09-02T15:00:00.000+07:00",206.83],["2021-09-02T16:00:00.000+07:00",206.83],["2021-09-02T17:00:00.000+07:00",206.83],["2021-09-02T18:00:00.000+07:00",206.83],["2021-09-02T19:00:00.000+07:00",206.83],["2021-09-02T20:00:00.000+07:00",206.83],["2021-09-02T21:00:00.000+07:00",206.84],["2021-09-02T22:00:00.000+07:00",206.85],["2021-09-02T23:00:00.000+07:00",206.86],["2021-09-03T00:00:00.000+07:00",206.87],["2021-09-03T01:00:00.000+07:00",206.89],["2021-09-03T02:00:00.000+07:00",206.91],["2021-09-03T03:00:00.000+07:00",206.93],["2021-09-03T04:00:00.000+07:00",206.95],["2021-09-03T05:00:00.000+07:00",206.96],["2021-09-03T06:00:00.000+07:00",206.97],["2021-09-03T07:00:00.000+07:00",206.98],["2021-09-03T08:00:00.000+07:00",207.00],["2021-09-03T09:00:00.000+07:00",207.02],["2021-09-03T10:00:00.000+07:00",207.04],["2021-09-03T11:00:00.000+07:00",207.06],["2021-09-03T12:00:00.000+07:00",207.08],["2021-09-03T13:00:00.000+07:00",207.11],["2021-09-03T14:00:00.000+07:00",207.14],["2021-09-03T15:00:00.000+07:00",207.17],["2021-09-03T16:00:00.000+07:00",207.18],["2021-09-03T17:00:00.000+07:00",207.19],["2021-09-03T18:00:00.000+07:00",207.20],["2021-09-03T19:00:00.000+07:00",207.20],["2021-09-03T20:00:00.000+07:00",207.20],["2021-09-03T21:00:00.000+07:00",207.20],["2021-09-03T22:00:00.000+07:00",207.19],["2021-09-03T23:00:00.000+07:00",207.18],["2021-09-04T00:00:00.000+07:00",207.17],["2021-09-04T01:00:00.000+07:00",207.18],["2021-09-04T07:00:00.000+07:00",207.30]]}]
Blockquote
I have tried to get this data with VBA but unsuccess, somebody can help me with VBA code to get data from "data".
This the code i have used:
Public Sub exceljson()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://cdh.vnmha.gov.vn/KiWIS/KiWIS?service=kisters&type=queryServices&request=getTimeseriesValues&datasource=0&format=dajson&ts_id=96643010&period=P3D", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
For Each Item In JSON
Sheets(1).Cells(i, 1).Value = Item("data")
i = i + 1
Next
MsgBox ("complete")
End Sub
Related
Accessing keys and values in nested object with VBA
I use the translation API from Deepl in VBA. My request is working pretty fine and returns some translated html-text. However, I am not able to get the "text"-value in the returned object:
So my request looks as follows:
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
url = api & "?" & authKey & "&" & targetLng & "&" & tagHandling & "&" & sourceLng
Debug.Print url
objHTTP.Open "POST", url, False
objHTTP.setRequestHeader "Host", "api-free.deepl.com"
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Accept", "*/*"
objHTTP.send "text=" & text
textResponse = objHTTP.responseText 'textResponse is defined as String
Debug.Print textResponse
I get the following output:
{
"translations":
[
{"detected_source_language":"DE",
"text":"<h2>SizeI</h2>love \"Paperwhite\".<br><br><img
src=\"https://ws-eu.amazon-adsystem.com/widgets/q?_encoding=UTF8"
}
]
}
I further tried:
'get the script control:
Set ScriptEngine = CreateObject("ScriptControl")
ScriptEngine.Language = "JScript"
'Get the string and parse it:
Set jsonObject = ScriptEngine.Eval("(" & textResponse & ")")
jsonObject returns [object Object] and I have no idea how to process this.
How can I access this object and return just the text-value?
Using VBA-JSON from here: https://github.com/VBA-tools/VBA-JSON
Function Test20220318()
Dim json As Object, txt, trans As Collection, t As Object, k
txt = [E1].Value 'using json stored in a cell for testing
Set json = JsonConverter.ParseJson(txt) 'a Dictionary object
Set trans = json("translations") 'access dictionary by key to get collection/array
For Each t In trans 'loop over items in collection/array
For Each k In t 'loop over keys in t
Debug.Print k, "=", t(k) 'print key and associated value
Next
Next t
End Function
The response is a JSON String. You have to convert the JSON string to an object Set jsonObject = DecodeJsonString(objHTTP.responseText)
Access response in Json
I am using the JSON VBA library to parse a large JSON response but I can not access the elements of the response as expected.
For example the response has the structure:
{employees: [{employeeId: {id: 1234}, personNumber: "ABC123", shortName: "Bob",...},...],...}
I have tried :
Dim JsonPayload As Object
Set JsonPayload = JsonConverter.ParseJson(req.ResponseText)
MsgBox JsonPayload("dict_pDictionary")
MsgBox JsonPayload("employees")(1)("employeeId")
And also :
Set emp = JsonPayload("employees")
For Each e In emp
Debug.Print "employee", e.shortName
Debug.Print "shortName", e
Debug.Print "shortName", e.dict_pDictionary
Next e
The error is Object Does not support this property or method.
I would like to know how to loop over the response. Some are variant/object/dictionary and other parts seem to be variant/object/collection
VBA JSON converts objects ({}) to Dictionaries, and Arrays ([]) to Collections.
In your code e is a Dictionary object, not an object with named properties, so:
Dim jso As Object, emps, e
Set jso = JsonConverter.ParseJson( _
"{""employees"":[{""employeeId"": {""id"": 1234}, ""personNumber"": ""ABC123"", ""shortName"": ""Bob""}]}")
Set emps = jso("employees")
For Each e In emps
Debug.Print e("employeeId")("id") '>> 1234
Debug.Print e("shortName") '>> Bob
Next e
How to get, JSON values to Work in VBA-JSON?
I am trying to access nested JSON values that come back from the API that I am working with at the moment. There seem to be no field names to use in this JSON, making it very difficult to follow most examples online.
API URL - CLICK HERE
I am using VBA-JSON through this process, and I've got it to successfully display "responseText" in MsgBox.
I am looking for a way to make this code work.
Public Sub exceljson()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://api.bitfinex.com/v2/candles/trade:5m:tEOSUSD/hist?start=1535760000000&end=1538265600000&sort=1", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
For Each Item In JSON
Sheets(1).Cells(i, 1).Value = Item("one") ' Items reference as an example
Sheets(1).Cells(i, 2).Value = Item("two")
Sheets(1).Cells(i, 3).Value = Item("three")
Sheets(1).Cells(i, 4).Value = Item("four")
Sheets(1).Cells(i, 5).Value = Item("five")
i = i + 1
Next
MsgBox ("complete")
End Sub
In my answer to Using VBA and VBA-JSON to access JSON data from Wordpress API
, I wrote a function, PrintJSONAccessors(), which breaks down how to access the data in a JSON structure.
Checking the JSON object in the Locals Window reveals that it consists of a collection of collections.
Checking the TypeName of the item in the Immediate Window also reveals that item is indeed a collection'
?TypeName(Item)
Collection
PrintJSONAccessors JSON, "?JSON"
The code will output the correct way to access the data
Here is how you can access the items of the Collection
For Each Item In JSON
Sheets(1).Cells(i, 1).Value = Item(1) ' Items reference as an example
Sheets(1).Cells(i, 2).Value = Item(2)
Sheets(1).Cells(i, 3).Value = Item(3)
Sheets(1).Cells(i, 4).Value = Item(4)
Sheets(1).Cells(i, 5).Value = Item(5)
i = i + 1
Next
I would write a function to convert the JSON data into an Array
Public Sub exceljson()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://api.bitfinex.com/v2/candles/trade:5m:tEOSUSD/hist?start=1535760000000&end=1538265600000&sort=1", False
http.Send
Dim results As Variant
results = BitfinexTextToArray(http.responseText)
Worksheets(1).Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results
MsgBox ("complete")
End Sub
Function BitfinexTextToArray(responseText As String) As Variant
Dim item As Variant, JSON As Object
Dim MaxColumns As Long
Set JSON = ParseJson(responseText)
For Each item In JSON
If item.Count > MaxColumns Then MaxColumns = item.Count
Next
Dim results As Variant
ReDim results(1 To JSON.Count, 1 To MaxColumns)
Dim c As Long, r As Long
For Each item In JSON
r = r + 1
For c = 1 To item.Count
results(r, c) = item(c)
Next
Next
BitfinexTextToArray = results
End Function
Access Values In Nested Array in JSON response
I have a multidimensional JSON array returned via a web request (http://www.coincap.io/history/365day/BTC). I want to cycle through the 2nd entry and retrieve its nested values.
If this was a normal array, I'd use:
For Each item In response
logic, logic, logic
currentRow = currentRow + 1
Next
This web request returns a JSON-response with 3 entries: market_cap, price, and volume. I just want to cycle through response(1) and get the price values. Each entry in price contains two keys, 0 and 1.
I would imagine that I could accomplish this by doing
For Each item in response(1)
Cells(currentRow, 1).Value = item(0)
Cells(currentRow, 2).Value = item(1)
currentRow = currentRow + 1
Next
I've also considered For Each item in response("price"). Neither works.
Sub Tester()
Dim json As String
Dim sc As Object
Dim o, n, i, p
Set sc = CreateObject("scriptcontrol")
sc.Language = "JScript"
json = HttpGet("http://www.coincap.io/history/365day/BTC")
sc.Eval "var obj=(" & json & ")" 'evaluate the json response
'add a couple of accessor functions
sc.AddCode "function numPrices(){return obj.price.length;}"
sc.AddCode "function getPrice(i){return obj.price[i];}"
n = sc.Run("numPrices")
For i = 0 To n - 1
p = Split(sc.Run("getPrice", i), ",")
Debug.Print i, p(0), p(1)
Next i
End Sub
Function HttpGet(url As String) As String
Dim oHTML As Object
Set oHTML = CreateObject("Microsoft.XMLHTTP")
With oHTML
.Open "GET", url, False
.send
HttpGet = .responsetext
End With
End Function
Loop until website has no additional JSON arrays to parse
I am looking for a loop function/syntax that will allow my loop to cease once the website I am pulling JSON arrays from has no additional arrays left to parse (variable / unknowable number of arrays).
Thank you for the insight.
sheetCount = 1
i = 1
urlArray = Array("URL array list")
Dim MyRequest As Object
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
Dim MyUrls
MyUrls = urlArray
Dim k As Long
Dim Json As Object
For k = LBound(MyUrls) To UBound(MyUrls)
With MyRequest
.Open "GET", MyUrls(k)
.Send
Set Json = JsonConverter.ParseJson(.ResponseText)
Do Until ''[NEED HELP HERE]
Sheets("Sheet" & sheetCount).Cells(i, 1) = Json("cars")(i)("carType")
Sheets("Sheet" & sheetCount).Cells(i, 2) = Json("cars")(i)("fare")("carprice")
i = i + 1
Loop
End With
sheetCount = sheetCount + 1
Next
You are missing the UBound function.
Other notes
No code without Option Explicit, period. No exceptions.
Make small functions that do one thing only.
Add references to the libraries you use instead of using CreateObject. It will make your life a lot easier because this way you get compile-time type checking and Intellisense.
It's safer to use the Exists() method to check if a dictionary key exists before you try to access it. Trying to access a non-existing key will throw a run-time error.
I'm silently assuming that you are using https://github.com/VBA-tools/VBA-JSON.
This should be close enough:
Option Explicit
Function GetJson(ByVal url As String) As Dictionary
With New WinHttpRequest ' see http://stackoverflow.com/a/3119794/18771
.Open "GET", url
.Send
Set GetJson = JsonConverter.ParseJson(.ResponseText)
End With
End Function
Sub FillCarInfo(data As Dictionary, sheet As Worksheet)
Dim i As Integer, car As Dictionary
For i = 0 To UBound(data("cars")) - 1
Set car = data("cars")(i)
' you probably should use If car.Exists("carType") Then
sheet.Cells(i, 1) = car("carType")
sheet.Cells(i, 1) = car("fare")("carprice")
Next i
End Sub
Sub FillMultipleCarInfo(urls As Variant, book As Workbook)
Dim i As Integer, data As Dictionary, sheet As Worksheet
For i = 0 To UBound(urls) - 1
Set data = GetJson(urls(i))
Set sheet = book.Sheets(i + 1)
FillCarInfo data, sheet
Next i
End Sub
Usage
Dim myUrls As Variant
myUrls = Array("URL array list")
FillMultipleCarInfo myUrls, ActiveWorkbook