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)
Related
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
I'm new to StackOverflow, and I'm struggling with displaying data from a dimensional JSON array in VBA (Excel). Could you please help?
Below are the codes I'm using for displaying the data of "ShippingMethod" from the JSON.
Example of JSON:
As you are able to see the "Data" is the first object.
"Shipments" and "DisplayItems" are the array of "Data".
Also, there are multiple objects inside the "Shipments" array.
For example "ShippingMethod" and "ShippingName", and my goal is to display the data of these objects. ("LC") and ("No Charge - Lowest Cost 3-5 Day Delivery")
Here are my codes:
First method:
Dim Json1 As Dictionary
Set Json1 = JsonConverter.ParseJson(strResponse3)
home.Activate
home.Cells(x, 2) = Json1("Data")("Shipments")(1)("ShippingMethod")
Second method:
Dim Json1 As Dictionary
Set Json1 = JsonConverter.ParseJson(strResponse3)
home.Activate
x = 42
For Each Item In Json1("Data")("Shipments")
home.Cells(x, 2) = Item("ShippingMethod")
x = x + 1
Next
I'm not able to display the data of these "ShippingMethod" and "ShippingName" objects as I'm getting an error message "Run-time error '13': Type mismatch" from the VBA.
NOTE: I'm using the same method on another JSON XML, it's able to retrieve the data from the dimensional JSON array without any issues.
Update on my codes(7/8)
Dim Json1 As Dictionary, x As Long, y As Long
Dim shipments
home.Activate
x = 42
Set Json1 = JsonConverter.ParseJson(strResponse3)
Set shipments = Json1("Data")("Shipments") '<-- Getting error "Run-time error '13': Type mismatch"'
For y = 3 To shipments.count
home.Cells(x, 2) = shipments(y)("ShippingMethod")
x = x + 1
Next
Error message_screenshot for Set shipments = Json1("Data")("Shipments")
The VBA highlight this line of code after selecting "Debug" button.
Note: try the below debug.print. However, the data returned as "0".
Debug.Print VarType(Json1("Data")("Shipments"))
Update on my codes(7/21)
Dim Json1 As Dictionary, x As Long, y As Long
Dim FSO, ts, s As String
Dim shipments
home.Activate
' write json to file
Set FSO = CreateObject("Scripting.FileSystemObject")
s = ThisWorkbook.Path & "\strResponse3.json"
Set ts = FSO.CreateTextFile(s)
ts.Write strResponse3
ts.Close
MsgBox Len(strResponse3) & " bytes written to " & s
x = 42
Set Json1 = JsonConverter.ParseJson(strResponse3)
Debug.Print "Json1", VarType(Json1)
Debug.Print "Json1(Data)", VarType(Json1("Data"))
Debug.Print "Json1(Data)(PriceSummary)", VarType(Json1("Data")("PriceSummary"))
Debug.Print "Json1(Data)(Shipments)", VarType(Json1("Data")("Shipments"))
Debug.Print "Json1(Data)(DisplayItems)", VarType(Json1("Data")("DisplayItems"))
home.Cells(x, 1) = Json1("Data")("Orders")("ShipmentId")
Set shipments = Json1("Data")("Shipments")
'home.Activate
For i = 1 To shipments.count
Cells(x, 2) = shipments(i)("ShippingMethod")
x = x + 1
Next
In the Txt output file, I noticed it only returning the data of "Data":{"PriceSummary":{,. Please see the beginning of the data TXT OUTPUT screenshot and compare it with the JSON screenshot.
Also, please check the ending of the data TXT OUTPUTand compare it with the JSON screenshot. The data only contain whenever inside the "PurchaseSummary" and there is no data with the arrays "Shipment" and "DisplayItems".
Here's the Debug.Print screenshot. No data returns for Shipments and DisplayItems.
I strongly believe there is something wrong with the JSON. (Kindly please refer back to the very first screenshot for the JSON pattern)
Debug.Print result:
Json1 9
Json1(Data) 9
Json1(Data)(PriceSummary) 9
Json1(Data)(Shipments) 0
Json1(Data)(DisplayItems) 0
Update - added JSON file export and test data.
Option Explicit
Sub test()
Dim Json1 As Dictionary, x As Long, i As Long
Dim shipments
Dim FSO, ts, strResponse3 As String, s As String
strResponse3 = "{""Data"" : {" & _
"""Shipments"":[" & _
"{""ShippingMethod"":""LC""}," & _
"{""ShippingMethod"":""LC""}," & _
"{""ShippingMethod"":""LC""}" & _
"]}}"
' write json to file
Set FSO = CreateObject("Scripting.FileSystemObject")
s = ThisWorkbook.Path & "\strResponse3.json"
Set ts = FSO.CreateTextFile(s)
ts.Write strResponse3
ts.Close
MsgBox Len(strResponse3) & " bytes written to " & s
Set Json1 = JsonConverter.ParseJson(strResponse3)
Debug.Print "Json1", VarType(Json1)
Debug.Print "Json1(Data)", VarType(Json1("Data"))
Debug.Print "Json1(Data)(Shipments)", VarType(Json1("Data")("Shipments"))
Set shipments = Json1("Data")("Shipments")
'home.Activate
x = 42
For i = 1 To shipments.Count
Cells(x, 2) = shipments(i)("ShippingMethod")
x = x + 1
Next
End Sub
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
I'm using the Newtonsoft JSON library. I want to loop through a JSON result set without having to create a separate class if possible, since the JSON object is far more extended that displayed here.
I already looked here and here.
My JSON (beautified at bottom of post):
Dim json As String = "{""result"":{""a326f402f18ab1cd2c4489b07cc3e8f4"":{""id"":""a326f402f18ab1cd2c4489b07cc3e8f4"",""client_id"":30,""broker"":[{""broker_id"": 30,""name"": ""Andrew"",""emailaddress"": ""andrew#homes.com""}],""photos"":[{""small"":""https://www.example.com/30/photos/small/66.1427790195-976.jpg"",""middle"":""https://www.example.com/30/photos/middle/66.1427790195-976.jpg""},{""small"":""https://www.example.com/30/photos/small/31382.1508417843-454.JPG"",""middle"":""https://www.example.com/30/photos/middle/31382.1508417843-454.JPG""}]},""18aec266ec0c01d126e9715bc17124e2"":{""id"":""18aec266ec0c01d126e9715bc17124e2"",""client_id"":30,""broker"":[{""broker_id"": 30,""name"": ""Andrew"",""emailaddress"": ""andrew#homes.com""}],""photos"":[{""small"":""https://www.example.com/30/photos/small/10.1298385655.jpg"",""middle"":""https://www.example.com/30/photos/middle/10.1298385655.jpg""},{""small"":""https://www.example.com/30/photos/small/10.1298385646.jpg"",""middle"":""https://www.example.com/30/photos/middle/10.1298385646.jpg""}]}}}"
I first tried with JsonTextReader, but that seemed too cumbersome in trying to access the individual properties quickly:
Dim sBuilder As New StringBuilder
Dim reader As JsonTextReader = New JsonTextReader(New StringReader(json))
While reader.Read
If reader.Value IsNot Nothing Then
sBuilder.Append(String.Format("Token: {0}, Value: {1}", reader.TokenType.ToString, reader.Value.ToString))
Else
sBuilder.Append(String.Format("Token: {0}", reader.TokenType.ToString))
End If
sBuilder.Append("<br/>")
End While
I then tried to work with JObject and JArray. The problem there is that the JSON response is generated by a 3rd party and IMO is not formatted well, since the result object should actually be an array. Also the results contain dynamic IDs (a326f402f18ab1cd2c4489b07cc3e8f4 and 18aec266ec0c01d126e9715bc17124e2)
So, I'm now faced with: how can I loop through all results when result is not an array and each result is also identified by a dynamic id?
Pseudo code:
Loop through the number of results (in this case 2: a326f402f18ab1cd2c4489b07cc3e8f4 and 18aec266ec0c01d126e9715bc17124e2)
For each of those results I want to select the attributes. This does not necessarily have to be strongly typed (json.photos(j).small), I'd be fine with something like json(i)("photos")(j)("small")
_
Dim photoSmall As String
Dim clientId As Integer
For i As Integer = 0 To json.count - 1
With json(i)
clientId = json.client_id
For J As Integer= 0 To json.photos.count - 1
photoSmall = json.photos(j).small
Next J
End With
Next i
Beautified JSON
{
"result": {
"a326f402f18ab1cd2c4489b07cc3e8f4": {
"id": "a326f402f18ab1cd2c4489b07cc3e8f4",
"client_id": 30,
"broker": [
{
"broker_id": 30,
"name": "Andrew",
"emailaddress": "andrew#homes.com"
}
],
"photos": [
{
"small": "https://www.example.com/30/photos/small/66.1427790195-976.jpg",
"middle": "https://www.example.com/30/photos/middle/66.1427790195-976.jpg"
},
{
"small": "https://www.example.com/30/photos/small/31382.1508417843-454.JPG",
"middle": "https://www.example.com/30/photos/middle/31382.1508417843-454.JPG"
}
]
},
"18aec266ec0c01d126e9715bc17124e2": {
"id": "18aec266ec0c01d126e9715bc17124e2",
"client_id": 30,
"broker": [
{
"broker_id": 30,
"name": "Andrew",
"emailaddress": "andrew#homes.com"
}
],
"photos": [
{
"small": "https://www.example.com/30/photos/small/10.1298385655.jpg",
"middle": "https://www.example.com/30/photos/middle/10.1298385655.jpg"
},
{
"small": "https://www.example.com/30/photos/small/10.1298385646.jpg",
"middle": "https://www.example.com/30/photos/middle/10.1298385646.jpg"
}
]
}
}
}
UPDATE 2
This code returns an array
Dim photosTEST As JArray = DirectCast(item("photos"), JArray)
Log("photosTEST length", photosTEST.Count.ToString)
But this code throws error: Object reference not set to an instance of an object
Dim brokers As JArray = DirectCast(item("broker"), JArray)
Log("brokers length", brokers.Count.ToString)
I don't understand since broker is just an array with length of 1 correct?
You can cast the result JToken to a JObject and loop through its Properties() collection. The Value of each of those properties is another JObject containing the data (e.g. id, client_id, photos, etc.) you are interested in.
Here is an example:
Dim obj As JObject = JObject.Parse(json)
Dim result As JObject = DirectCast(obj("result"), JObject)
For Each prop As JProperty In result.Properties()
Dim item As JObject = DirectCast(prop.Value, JObject)
Dim id As String = item("id").Value(Of String)
Dim clientId As Integer = item("client_id").Value(Of Integer)
Console.WriteLine("id: " & id)
Console.WriteLine("client id: " & clientId.ToString())
Dim brokers As JArray = DirectCast(item("broker"), JArray)
For i As Integer = 0 To brokers.Count - 1
Dim broker As JObject = DirectCast(brokers(i), JObject)
Dim brokerId As Integer = broker("broker_id").Value(Of Integer)
Dim name As String = broker("name").Value(Of String)
Dim email As String = broker("emailaddress").Value(Of String)
Console.WriteLine("broker " & i.ToString() & " id: " & brokerId)
Console.WriteLine("broker " & i.ToString() & " name: " & name)
Console.WriteLine("broker " & i.ToString() & " email: " & email)
Next
Dim photos As JArray = DirectCast(item("photos"), JArray)
For i As Integer = 0 To photos.Count - 1
Dim photo As JObject = DirectCast(photos(i), JObject)
Dim small As String = photo("small").Value(Of String)
Dim middle As String = photo("middle").Value(Of String)
Console.WriteLine("photo " & i.ToString() & " small: " & small)
Console.WriteLine("photo " & i.ToString() & " middle: " & middle)
Next
Console.WriteLine()
Next
Fiddle: https://dotnetfiddle.net/ALeiX8
Note that the code above assumes that all of the object properties in your example JSON will always be present. If it is possible that a particular property might not appear, then you will need to do a check for Nothing on that property before trying to use its value. For example, you mentioned that you are getting an Object reference not set to an instance of an object error when you try to access the broker count. That tells me that for some of your result items, there is not a broker property in the JSON. In that case, you would need to change the code to check for Nothing like this:
Dim brokers As JArray = DirectCast(item("broker"), JArray)
If brokers IsNot Nothing Then
For i As Integer = 0 To brokers.Count - 1
Dim broker As JObject = DirectCast(brokers(i), JObject)
Dim brokerId As Integer = broker("broker_id").Value(Of Integer)
Dim name As String = broker("name").Value(Of String)
Dim email As String = broker("emailaddress").Value(Of String)
Console.WriteLine("broker " & i.ToString() & " id: " & brokerId)
Console.WriteLine("broker " & i.ToString() & " name: " & name)
Console.WriteLine("broker " & i.ToString() & " email: " & email)
Next
End If
Similarly, if a broker might not have an email address, then you would need to do something like this:
Dim email As String = ""
If broker("emailaddress") IsNot Nothing Then
email = broker("emailaddress").Value(Of String)
End If
In fact, if you find that there are many properties in the JSON which you cannot count on always being there, you can write a little extension method to help simplify your code. This method will allow you to supply a default value to be used in place of a particular JToken if it turns out to be Nothing:
Imports System.Runtime.CompilerServices
Imports Newtonsoft.Json.Linq
Module JsonExtensions
<Extension()>
Public Function ValueOrDefault(Of T)(token As JToken, defaultValue As T) As T
If token IsNot Nothing AndAlso token.Type <> JTokenType.Null Then
Return token.Value(Of T)
Else
Return defaultValue
End If
End Function
End Module
Then you can use it in wherever you are currently using Value(Of T) or DirectCast on a JToken. For example:
Dim brokers As JArray = item("broker").ValueOrDefault(new JArray())
Or:
Dim email As String = broker("emailaddress").ValueOrDefault("")
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