[ACCEPTED]-Excel VBA: Parsed JSON Object Loop-scriptcontrol

The JScriptTypeInfo object is a bit unfortunate: it contains 16 all the relevant information (as you can 15 see in the Watch window) but it seems impossible 14 to get at it with VBA.

If the JScriptTypeInfo instance refers 13 to a Javascript object, For Each ... Next won't work. However, it 12 does work if it refers to a Javascript array 11 (see GetKeys function below).

So the workaround 10 is to again use the Javascript engine to 9 get at the information we cannot with VBA. First 8 of all, there is a function to get the keys 7 of a Javascript object.

Once you know the 6 keys, the next problem is to access the 5 properties. VBA won't help either if the 4 name of the key is only known at run-time. So 3 there are two methods to access a property 2 of the object, one for values and the other 1 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 10 of a solution.

However, did you know VBA's 9 CallByName gets you pretty far in querying a JSON 8 structure. I've just written a solution 7 over at Google Places Details to Excel with VBA for an example.

Actually just rewritten 6 it without managing to use the functions 5 adding to ScriptEngine as per this example. I 4 achieved looping through an array with CallByName 3 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 2 it does sub-objects (nested objects) as 1 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 2 of OO (or is it javascript ;) You can add 1 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 6 easily be handled if we can manipulate it 5 the right way, no matter how complex the 4 structure is. I don't think it is necessary 3 to use any external library or converter 2 to do the trick. Here is an example where 1 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 19 solution, I stumbled upon this thread. It 18 did help but if we need to access the data 17 without Keys at runtime dynamically, the 16 answers above, still need a few more tweaks 15 to get the desired data.

I finally came up 14 with a function to have an end-to-end neat 13 solution to this JSON parsing problem in 12 VBA. What this function does is, it takes 11 a JSON string(nested to any level) as input 10 and returns a formatted 2-dimensional array. This 9 array could further easily be moved to Worksheet 8 by plain i/j loops or could be played around 7 conveniently due to its easy index-based 6 accessibility.

Sample input-output

The function is saved in 5 a JSON2Array.bas file at my Github repo. JSON2Array-VB

A 4 demo usage subroutine is also included in 3 the .bas file. Please download and import 2 the file in your VBA modules. I hope it 1 helps.

I know it's late, but for those who doesn't 8 know how to use VBJSON, you just have to:

1) Import 7 JSON.bas into your project (Open VBA Editor, Alt 6 + F11; File > Import File)

2) Add Dictionary 5 reference/class For Windows-only, include 4 a reference to "Microsoft Scripting 3 Runtime"

You can also use the VBA-JSON the same 2 way, which is specific for VBA instead of 1 VB6 and has all the documentation.