Excel VBA: Parsed JSON Object Loop
Solution 1
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.
Solution 2
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
Solution 3
Super Simple answer - through the power of OO (or is it javascript ;) You can add the item(n) method you always wanted!
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
Solution 4
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.
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.
Solution 5
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
Related videos on Youtube
rr789
Updated on May 18, 2020Comments
-
rr789 about 4 years
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
-
rr789 about 13 yearsFyi: Got function code from here: tech.groups.yahoo.com/group/json/message/972 (don't have enough karma to put another link in the question).
-
rr789 about 13 yearsFyi: This Japanese user wrote a good piece on the issue: translate.google.com/…
-
Tim Williams about 13 yearsYour first example doesn't work because "arr" is a native js object and it doesn't have "keys". Other libraries parse json directly to a dictionary (possibly with other nested dictionaries). That's why your second example works: you're iterating over the dictionary's keys.
-
Chloe over 10 years@randyr I found this information to be inaccurate:
objJSON ["key"]
. When I tried that syntax, the VBA editor kept changing it toDebug.Print arr; ["key"]
and inserting a semicolon. -
Charles Wood over 8 yearsThese days I'd recommend JsonBag. Only one class, comes with documentation, and it's very easy to use.
-
omegastripes over 8 yearsNote that the above approach makes the system vulnerable in some cases, since it allows the direct access to the drives (and other stuff) for the malicious JS code via ActiveX's. Let's suppose you are parsing web server response JSON, like
JsonString = "{a:(function(){(new ActiveXObject('Scripting.FileSystemObject')).CreateTextFile('C:\\Test.txt')})()}"
. After evaluating it you'll find new created fileC:\Test.txt
. So JSON parsing withScriptControl
ActiveX is not a good idea. Check the update of my answer for the RegEx-based JSON parser. -
Michele Locati over 2 yearsI've just written a couple of VBA files that lets you parse JSON very easily - see github.com/mlocati/vba-json
-
rr789 over 2 yearsMichele, thanks for sharing. That library looks great...
-
-
rr789 over 12 yearsCodo thanks - answered. This will set me on the right path. I'll let Bastan know also (he has a linked question to this).
-
Chloe over 10 yearsThis did not work.
sc.AddCode "Object.prototype.get=function( i ) { return this[i]; };"
...Debug.Print arr.get("key")
... Error:Method 'get' of object 'JScriptTypeInfo' failed
. -
Suneel Kumar over 9 years@Codo Thanks, please tell me if we have some inbuilt libraries now.
-
MrMesees over 9 yearsFor anyone having issues with VBE or just not wanting to use it, I use
Sub JSON() Dim o As Object Set o = CreateObject("ScriptControl") o.Language = "JScript" Dim output As String output = o.Eval("(" + "{""bob"":""Bobs Name"",""jim"":[1,2,3,4,5]}" + ")").bob MsgBox output End Sub
-
omegastripes over 8 yearsNote that the above approach makes the system vulnerable in some cases, since it allows the direct access to the drives (and other stuff) for the malicious JS code via ActiveX's. Let's suppose you are parsing web server response JSON, like
JsonString = "{a:(function(){(new ActiveXObject('Scripting.FileSystemObject')).CreateTextFile('C:\\Test.txt')})()}"
. After evaluating it you'll find new created fileC:\Test.txt
. So JSON parsing withScriptControl
ActiveX is not a good idea. Check the update of my answer for the RegEx-based JSON parser. -
Excel Hero almost 4 yearsWhile the Script Control is cool, it comes with lots of problems, especially with 64-bit VBA. My solution avoids the Script Control and works no matter how complex the JSON is.