Reading a JSON and looping in VBA

Question

I'm getting from the server a JSON string with the statuses of a particular actions. In this case it returns results for 2 actions. For ID: 551720 and ID: 551721

String looks like this:

[{"ElectronicId":551720,"DocumentNr":"130/10/15",
"DocumentTypeId":1,"DocumentTypeName":"eInvoice",
"StatusId":30,"StatusName":"Sent","RecipientBusinessNumber":"0050960000",
"RecipientBusinessUnit":"","RecipientBusinessName":"Comp d.o.o.",
"Created":"2019-07-23T21:21:23.743","Updated":"2019-07-23T21:21:24.587",
"Sent":"2019-07-23T21:21:24.587","Delivered":null},
{"ElectronicId":551721,"DocumentNr":"130/10/15",
"DocumentTypeId":1,"DocumentTypeName":"eInvoice",
"StatusId":30,"StatusName":"Sent","RecipientBusinessNumber":"00509605454",
"RecipientBusinessUnit":"","RecipientBusinessName":"Comp d.o.o.",
"Created":"2019-07-23T21:23:05.887","Updated":"2019-07-23T21:23:07.043",
"Sent":"2019-07-23T21:23:07.043","Delivered":null}]

Sometimes it returns 1, sometimes 2, or maybe 20 statuses (different "ElectronicId")

How could I loop within JSON. I have a code that works when I have only 1 response, but it doesn't work when I have more than 1. Here is the code for 1 response:

Dim cJS As New clsJasonParser

 cJS.InitScriptEngine

results = """""here goes the JSON string""""""

 Set JsonObject = cJS.DecodeJsonString(CStr(result))


        Debug.Print cJS.GetProperty(JsonObject, "ElectronicId")
        Debug.Print cJS.GetProperty(JsonObject, "DocumentNr")
        Debug.Print cJS.GetProperty(JsonObject, "DocumentTypeId")
        Debug.Print cJS.GetProperty(JsonObject, "DocumentTypeName")
        Debug.Print cJS.GetProperty(JsonObject, "StatusId")

Here is the code for the clsJasonParser bClass:

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

Would really recommend *not* using the JScript engine to Eval JSON (though I have used it in answers here previously...) - that can execute arbitrary code on your PC and leaves you vulnerable to thing like creating a new Scripting.FileSystemObject and deleting your files. JScript executing outside of the browser doesn't get sandboxed. — Tim Williams, Jul 24 '19 at 18:01
@Tim Williams no problem to use some other solutions to solve my problem — davor.geci, Jul 24 '19 at 18:08

QHarr · Accepted Answer · 2019-07-24T18:11:53.653

I would use jsonconverter.bas to parse the json. After installing the code from that link in a standard module called JsonConverter, go to VBE > Tools > References > Add a reference to Microsoft Scripting Runtime.

Then I would dimension an array to hold the results. I would determine rows from the number of items in the json collection returned and the number of columns from the size of the first item dictionary. Loop the json object, and inner loop the dictionary keys of each dictionary in collection, and populate the array. Write the array out in one go at end.

Below, I am reading in the json string from cell A1 but you would replace that with your json source.

Option Explicit
Public Sub test()
    Dim json As Object, r As Long, c As Long, headers()
    Dim results(), ws As Worksheet, item As Object, key As Variant

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set json = JsonConverter.ParseJson(ws.[A1].Value)  '<Reading json from cell. Returns collection
    headers = json.item(1).keys  'each item in collection is a dictionary. Use .keys to get headers for results e.g. ElectronicId
    ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
    For Each item In json 'loop json and populate results array
        r = r + 1: c = 1
        For Each key In item.keys
            results(r, c) = item(key)
            c = c + 1
        Next
    Next
    With ws
        .Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(3, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

this looks interesting and I will try it out. Is there maybe also some way to use this in vb6? I was looking at that JsonConverter.bas but I don't think that I could convert it to vb6. But it should work in vba — davor.geci, Jul 24 '19 at 18:11
It does work in VBA. It won't work in vb6. With vb6 you could use similar overall logic however. — QHarr, Jul 24 '19 at 18:15
@TimWilliams Many thanks. Will be interesting to have a look at that. — QHarr, Jul 24 '19 at 18:22

Reading a JSON and looping in VBA

1 Answers1