Excel VBA: Parsed JSON Object Loop

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 ExplicitPrivate ScriptEngine As ScriptControlPublic 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 SubPublic Function DecodeJsonString(ByVal JsonString As String)    Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")End FunctionPublic Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant    GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)End FunctionPublic Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)End FunctionPublic 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 = KeysArrayEnd FunctionPublic 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.ocxOption ExplicitSub 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"    StopEnd 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 ScriptControlPublic 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") ' WTFEnd Sub