I am using ACCESS VBA to parse Json.
It is getting the value that are in the 1st curly braces.
But anything within the 2nd curly gives an error
Wrong number of arguments of invalid property assignment
JSON:
[
{
"Number": 1,
"Name": "John Doe",
"DateOfB": "2018-05-05",
"Place": {
"Pl": 4,
"Name": "England"
}
}
]
I am able to get the values for Number, Name and DateofB.
But I'm unable to get the value for Place for that I am getting the error.
I am using the widly available clsJsonParser module in my VBA application.
Following the sample in the clsJsonParser this is what works for you:
Public Sub TestJSON()
Dim JP As JSONParser
Set JP = New JSONParser
JP.Filename = "c:\myJson.txt"
Dim varData As Variant
Set varData = JP.Parse
Debug.Print varData(1)("Number")
Debug.Print varData(1)("Name")
Debug.Print varData(1)("DateOfB")
'You have to explicitely use a Dictionary type here to store the place.
Dim placeDictionary As Scripting.Dictionary
Set placeDictionary = varData(1)("Place")
'Output all keys and items of the place dictionary:
Dim index As Long
For index = 0 To placeDictionary.Count - 1
Debug.Print placeDictionary.Keys(index), placeDictionary.Items(index)
Next index
'Access place dictionary items by name:
Debug.Print placeDictionary("Pl")
Debug.Print placeDictionary("Name")
End Sub
You have to reference the Microsoft Scripting Runtime to introduce the type Scripting.Dictionary.
Code Below Worked:
For Each Appt In JSON
rs.AddNew
rs!Appt_ID = Appt("Number")
rs!ClientFullName = Appt("Name")
rs!Appt_Date = Appt("DateOfB")
rs!TC_Center = Appt("Place")("Pl")
rs.Update
Next
Related
I have an excel cell value [[{"Name":Ashwin ,"Age":64}],[],[{"Name":Shakur ,"Age":64,"Gender":Male}]]
I need to display the value of gender in cells.
Please find below my code:
Option Explicit
Sub ExampleSplit()
Dim s As String, vx() As String
My_array = Worksheets("sheet1").Cells(1, 1)
vx = Split(My_array, "{")
Array_need = "{" & Split(vx(UBound(vx)), "}")(0) & "}"
Set Jsonobject = JsonConverter.ParseJson(Array_need)
For Each Item In Jsonobject
If Item = "Gender" Then
Worksheets("sheet1").Cells(1, 2) = Item("Gender")
End If
Next
End Sub
After running sucessfuly,value "Male" should be in worksheets("sheet1").cells(1,2).But for me it was throwing "type mismatch"
I wrote PrintJSONAccessors() to answer a similar question: Using VBA and VBA-JSON to access JSON data from Wordpress API. My sub routine prints the proper way to access the json data to the Immediate Window.
The sample code is not valid JSON. It is missing double quotes around its string values.
[[{"Name":Ashwin ,"Age":64}],[],[{"Name":Shakur ,"Age":64,"Gender":Male}]]
This is the valid version:
[[{"Name":"Ashwin" ,"Age":64}],[],[{"Name":"Shakur" ,"Age":64,"Gender":"Male"}]]
Here is how I prepare to extract the JSON data:
Sub Prep()
Dim Data As Variant
Data = Worksheets("sheet1").Cells(1, 1).Value
Set Data = JsonConverter.ParseJson(Data)
PrintJSONAccessors Data, "Data"
Stop
End Sub
I put the Stop in the code so that I can test output in the Immediate Window.
Notice the data is a Dictionary inside a Collection inside another Collection.
good people of StackOverflow!
I am trying to figure out how to connect to Airtable API, get JSON from there and populate Access table with the results.
So far, at least I managed to restrict the request to give me only a few fields I need.The result looks like this:
{
"records": [{
"id": "rec008lgyvVmwk1F4",
"fields": {
"Date": "2018-02-28"
},
"createdTime": "2018-01-26T15:36:23.000Z"
}, {
"id": "rec02WozJeaGvfBfj",
"fields": {
"Hours": 1.5,
"Date": "2018-02-09",
"Project": ["Nonbillable"]
},
"createdTime": "2018-02-12T17:03:18.000Z"
}, {
"id": "rec05VxP0CYTsDYOA",
"fields": {
"Date": "2018-02-08"
},
"createdTime": "2018-02-01T10:29:52.000Z"
}, {
"id": "rec05xoQEm5iWIYmz",
"fields": {
"Hours": 0.75,
"Date": "2018-02-16",
"Project": ["2018 - Japan DLAs"]
},
"createdTime": "2018-02-19T09:29:18.000Z"
}]
}
From that point on I have read as many examples as I could find how to use VBA-JSON by Tim Hall (thank you Tim, for creating it :)
As far as I understand, in my case the ParseJson function returns a dictionary. Inside that is a collection named 'results' and inside that collection is another dictionary named 'fields'.
What I need are values for keys 'Hours', 'Date' and 'Project' from that dictionary.
I have tried to do those three loops (loop through dictionary inside collection inside dictionary) and was failing miserably many times with a variety of errors. Finally, I have come to the point where I see no more errors, the sub happily gives me "Import done!" message. Alas, my table is empty!
What, what am I doing wrong?
I hope I gave you enough information and thank you very much in advance for your help!
(If it matters, I'm working with 32-bit Access 2016 on 64-bit Windows)
Public Sub ImportJSON()
Dim reader As New XMLHTTP60
Dim JsonRetrieved As String
Dim Parsed As Scripting.Dictionary
Dim records As New Collection
Dim fields As Scripting.Dictionary
Dim item As Variant
Dim rs As New ADODB.Recordset
reader.Open "GET", "https://api.airtable.com/v0/apppLTTgKBsw5QmUX/myTable?fields[]=Project&fields[]=Hours&NOT({Hours} = '')&fields[]=Date&NOT({Date} = '')&maxRecords=4&api_key=mykey", False
reader.setRequestHeader "Accept", "application/json"
reader.Send
Do Until reader.ReadyState = 4
DoEvents
Loop
If reader.Status = 200 Then
rs.Open "tblAirtableImport", CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
JsonRetrieved = reader.responseText
'Debug.Print JsonRetrieved
Set Parsed = JsonConverter.ParseJson(JsonRetrieved)
'loop through dictionary 'Parsed'
Dim i As Long
For i = 0 To Parsed.Count - 1
'loop through collection 'records'. If we have hours logged into Airtable add new record (Hours, Date, Project) to Access table
For Each fields In records
'loop through dictionary 'fields'
Dim j As Long
For j = 0 To fields.Count - 1
If fields.Exists("Hours") Then
'MsgBox "We have hours in this row"
rs.AddNew
rs!AirtableHours = fields.item("Hours")
rs!AirtableDate = fields.item("Date")
rs!AirtableProject = fields.item("Project")
rs.Update
Else
MsgBox "No logged time."
End If
Next j
Next
Next i
MsgBox "Import done!"
Set Parsed = Nothing
Else
MsgBox "Ups, unable to import data. Reader status is: " & reader.Status
End If
End Sub
The entry Project holds an Array so take the first Item:
Set Parsed = JsonConverter.ParseJson(JsonRetrieved)
For Each record In Parsed("records")
Set fields = record("fields")
If fields.Exists("Hours") Then
rs.AddNew
rs!AirtableHours = fields("Hours")
rs!AirtableDate = fields("Date")
rs!AirtableProject = fields("Project")(1)
rs.Update
End If
Next
I keep receiving a "type mismatch error" (indicating that its not an array?) at:
Sub FillTaxiInfo
For i = 0 To UBound(data("prices")) - 1
The code is attempting to parse JSON from (see "prices" below):
{"id":1,"prices":[{"name":"expressTaxi","fare":{"fareType":"standard", "base":"$2.50"...}}
When I place a breakpoint and inspect "prices", it tells me that the 'Value' is Expression not defined in context and 'Type' is Empty.
Any other suggestions for improvement would be much appreciated.
My full code:
Option Explicit
Sub Run()
Dim myUrls As Variant
myUrls = Array("URL1, URL2, URL3")
FillMultipleCityInfo myUrls, ActiveWorkbook
End Sub
Function GetJson(ByVal url As String) As Dictionary
With New WinHttpRequest
.Open "GET", url
.Send
Set GetJson = JsonConverter.ParseJson(.ResponseText)
End With
End Function
Sub FillTaxiInfo(data As Dictionary, sheet As Worksheet)
Dim i As Integer, taxi As Dictionary
For i = 0 To UBound(data("prices")) - 1
Set taxi = data("prices")(i)
If taxi.Exists("name") Then
sheet.Cells(i, 1) = taxi("name")
sheet.Cells(i, 2) = taxi("fare")("fareType")
End If
Next i
End Sub
Sub FillMultipleCityInfo(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)
FillTaxiInfo data, sheet
Next i
End Sub
You are trying to receive the UBound() of an Dictionary data structure and not an Array. UBound() will only function on an Array.
Instead it appears you want to iterate over the keys of a Dictionary. Here is a small example how to do this.
Public Sub Dict_Iter()
Dim key As Variant 'Even though the key is a string --
'Objects/Variant are needed in a For Each Loop
Dim dict As New Dictionary
'Add several items to the dictionary
With dict
.Add "a", "a"
.Add "b", "b"
.Add "c", "c"
End With
'Iterate over the keys
For Each key In dict.Keys()
Debug.Print dict(key)
Next
End Sub
I need to update a currency table in MS-Access with a JSON file below:
{
"timestamp": 1465843806,
"base": "CAD",
"rates": {
"AED": 2.87198141,
"AFN": 54.21812828,
"ALL": 95.86530071,
"AMD": 374.48549935,
"ANG": 1.39861507
}
}
The VBA code is as follows:
Private Sub cmdJsonTest_Click()
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", "https://website.org/api/latest.json?base=CAD"
MyRequest.send
' MsgBox MyRequest.ResponseText
Dim Json As Object
Set Json = JsonConverter.ParseJson(MyRequest.ResponseText)
MsgBox Json("base")
End Sub
The above code works correctly displaying a message box with CAD but I need to loop through and capture each currency code along with it's rate value. What syntax do I use to do this? I can provide the code for the function Json() function but did not see a way to upload it. Any assistance would be appreciated.
If you are using this json parser https://github.com/VBA-tools/VBA-JSON, use this code
Private Sub IterateDictionary(poDict As Dictionary)
Dim key As Variant
For Each key In poDict.Keys()
If TypeName(poDict(key)) = "Dictionary" Then
Debug.Print key
IterateDictionary poDict(key)
Else
Debug.Print key, poDict(key)
End If
Next
End Sub
EDIT:
You have to modify the debug.print with whatever process you want to do. To use this from your code put this line after MsgBox.
IterateDictionary Json
You could also string parse. For example, if after key pairs for the rates:
Option Explicit
Public Sub GetValues()
Dim s As String, rates(), i As Long
s = "{""timestamp"": 1465843806,""base"": ""CAD"",""rates"": {""AED"": 2.87198141,""AFN"": 54.21812828,""ALL"": 95.86530071,""AMD"": 374.48549935,""ANG"": 1.39861507}}"
rates = Array("AED", "AFN", "ALL", "AMD", "ANG")
For i = LBound(rates) To UBound(rates)
Debug.Print rates(i) & ":" & GetRate(s, rates(i))
Next i
End Sub
Public Function GetRate(ByVal s As String, ByVal delimiter As String) As String
GetRate = Replace(Split(Split(s, delimiter & Chr$(34) & Chr$(58))(1), Chr$(44))(0), Chr$(125), vbNullString)
End Function
Per example below...Looping through an object from a parsed JSON string returns an error "Object doesn't support this property or method". Could anyone advise how to make this work? Much appreciated (I spent 6 hours looking for an answer before asking here).
Function to parse JSON string into object (this works OK).
Function jsonDecode(jsonString As Variant)
Set sc = CreateObject("ScriptControl"): sc.Language = "JScript"
Set jsonDecode = sc.Eval("(" + jsonString + ")")
End Function
Looping through the parsed object returns error "Object doesn't support this property or method".
Sub TestJsonParsing()
Dim arr As Object 'Parse the json array into here
Dim jsonString As String
'This works fine
jsonString = "{'key1':'value1','key2':'value2'}"
Set arr = jsonDecode(jsonString)
MsgBox arr.key1 'Works (as long as I know the key name)
'But this loop doesn't work - what am I doing wrong?
For Each keyName In arr.keys 'Excel errors out here "Object doesn't support this property or method"
MsgBox "keyName=" & keyName
MsgBox "keyValue=" & arr(keyName)
Next
End Sub
PS. I looked into these libraries already:
-vba-json Wasn't able to get the example working.
-VBJSON There's no vba script included (this might work but don't know how to load it into Excel and there is minimum documentation).
Also, Is it possible to access Multidimensional parsed JSON arrays? Just getting a basic key/value array loop working would be great (sorry if asking too much). Thanks.
Edit: Here are two working examples using the vba-json library. The question above is still a mystery though...
Sub TestJsonDecode() 'This works, uses vba-json library
Dim lib As New JSONLib 'Instantiate JSON class object
Dim jsonParsedObj As Object 'Not needed
jsonString = "{'key1':'val1','key2':'val2'}"
Set jsonParsedObj = lib.parse(CStr(jsonString))
For Each keyName In jsonParsedObj.keys
MsgBox "Keyname=" & keyName & "//Value=" & jsonParsedObj(keyName)
Next
Set jsonParsedObj = Nothing
Set lib = Nothing
End Sub
Sub TestJsonEncode() 'This works, uses vba-json library
Dim lib As New JSONLib 'Instantiate JSON class object
Set arr = CreateObject("Scripting.Dictionary")
arr("key1") = "val1"
arr("key2") = "val2"
MsgBox lib.toString(arr)
End Sub
The JScriptTypeInfo object is a bit unfortunate: it contains all the relevant information (as you can see in the Watch window) but it seems impossible to get at it with VBA.
If the JScriptTypeInfo instance refers to a Javascript object, For Each ... Next won't work. However, it does work if it refers to a Javascript array (see GetKeys function below).
So the workaround is to again use the Javascript engine to get at the information we cannot with VBA. First of all, there is a function to get the keys of a Javascript object.
Once you know the keys, the next problem is to access the properties. VBA won't help either if the name of the key is only known at run-time. So there are two methods to access a property of the object, one for values and the other one for objects and arrays.
Option Explicit
Private ScriptEngine As ScriptControl
Public Sub InitScriptEngine()
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub
Public Function DecodeJsonString(ByVal JsonString As String)
Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function
Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant
GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object
Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetKeys(ByVal JsonObject As Object) As String()
Dim Length As Integer
Dim KeysArray() As String
Dim KeysObject As Object
Dim Index As Integer
Dim Key As Variant
Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
Length = GetProperty(KeysObject, "length")
ReDim KeysArray(Length - 1)
Index = 0
For Each Key In KeysObject
KeysArray(Index) = Key
Index = Index + 1
Next
GetKeys = KeysArray
End Function
Public Sub TestJsonAccess()
Dim JsonString As String
Dim JsonObject As Object
Dim Keys() As String
Dim Value As Variant
Dim j As Variant
InitScriptEngine
JsonString = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }"
Set JsonObject = DecodeJsonString(CStr(JsonString))
Keys = GetKeys(JsonObject)
Value = GetProperty(JsonObject, "key1")
Set Value = GetObjectProperty(JsonObject, "key2")
End Sub
Note:
The code uses early binding. So you have to add a reference to "Microsoft Script Control 1.0".
You have to call InitScriptEngine once before using the other functions to do some basic initialization.
Codo's answer is great and forms the backbone of a solution.
However, did you know VBA's CallByName gets you pretty far in querying a JSON structure. I've just written a solution over at Google Places Details to Excel with VBA for an example.
Actually just rewritten it without managing to use the functions adding to ScriptEngine as per this example. I achieved looping through an array with CallByName only.
So some sample code to illustrate
'Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
Option Explicit
Sub TestJSONParsingWithVBACallByName()
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim jsonString As String
jsonString = "{'key1':'value1','key2':'value2'}"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + jsonString + ")")
Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
Debug.Assert VBA.CallByName(objJSON, "key2", VbGet) = "value2"
Dim jsonStringArray As String
jsonStringArray = "[ 1234, 4567]"
Dim objJSONArray As Object
Set objJSONArray = oScriptEngine.Eval("(" + jsonStringArray + ")")
Debug.Assert VBA.CallByName(objJSONArray, "length", VbGet) = "2"
Debug.Assert VBA.CallByName(objJSONArray, "0", VbGet) = "1234"
Debug.Assert VBA.CallByName(objJSONArray, "1", VbGet) = "4567"
Stop
End Sub
And it does sub-objects (nested objects) as well see Google Maps example at Google Places Details to Excel with VBA
EDIT: Don't use Eval, try to parse JSON safer, see this blog post
Super Simple answer - through the power of OO (or is it javascript ;)
You can add the item(n) method you always wanted!
my full answer here
Private ScriptEngine As ScriptControl
Public Sub InitScriptEngine()
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "Object.prototype.myitem=function( i ) { return this[i] } ; "
Set foo = ScriptEngine.Eval("(" + "[ 1234, 2345 ]" + ")") ' JSON array
Debug.Print foo.myitem(1) ' method case sensitive!
Set foo = ScriptEngine.Eval("(" + "{ ""key1"":23 , ""key2"":2345 }" + ")") ' JSON key value
Debug.Print foo.myitem("key1") ' WTF
End Sub
As Json is nothing but strings so it can easily be handled if we can manipulate it the right way, no matter how complex the structure is. I don't think it is necessary to use any external library or converter to do the trick. Here is an example where I've parsed json data using string manipulation.
Sub Json_data()
Const URL = "https://api.redmart.com/v1.5.8/catalog/search?extent=2&pageSize=6&sort=1&category=bakery"
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim str As Variant
With http
.Open "GET", URL, False
.send
str = Split(.responseText, "category_tags"":")
End With
On Error Resume Next
y = UBound(str)
For i = 1 To y
Cells(i, 1) = Split(Split(str(i), "title"":""")(1), """")(0)
Cells(i, 2) = Split(Split(str(i), "sku"":""")(1), """")(0)
Cells(i, 3) = Split(Split(str(i), "price"":")(1), ",")(0)
Cells(i, 4) = Split(Split(str(i), "desc"":""")(1), """")(0)
Next i
End Sub
So its 2020 and yet due to lack of an end-to-end solution, I stumbled upon this thread. It did help but if we need to access the data without Keys at runtime dynamically, the answers above, still need a few more tweaks to get the desired data.
I finally came up with a function to have an end-to-end neat solution to this JSON parsing problem in VBA. What this function does is, it takes a JSON string(nested to any level) as input and returns a formatted 2-dimensional array. This array could further easily be moved to Worksheet by plain i/j loops or could be played around conveniently due to its easy index-based accessibility.
Sample input-output
The function is saved in a JSON2Array.bas file at my Github repo.
JSON2Array-VB
A demo usage subroutine is also included in the .bas file.
Please download and import the file in your VBA modules.
I hope it helps.
I know it's late, but for those who doesn't know how to use VBJSON, you just have to:
1) Import JSON.bas into your project (Open VBA Editor, Alt + F11; File > Import File)
2) Add Dictionary reference/class
For Windows-only, include a reference to "Microsoft Scripting Runtime"
You can also use the VBA-JSON the same way, which is specific for VBA instead of VB6 and has all the documentation.