Multi-Array with Some Records having NULL nested arrays

[EPiSKiNG]

I'm sure I'm not handling this properly, but I have this JSON in which some records have nested arrays, and some do not. I need to put a blank value when the nested array is NULL.

Here's my current VBA:

Sub ImportTimeRecords()

    Dim httpReq As Object
    Dim strUrl As String
    Dim response As String
    Dim requestBody As String
    Dim JSON As Object
    Dim i As Long

strUrl = "REDACTED"

Set httpReq = CreateObject("MSXML2.ServerXMLHTTP")
    With httpReq
            .Open "GET", strUrl, False
            .SetRequestHeader "Content-Type", "application/json"
            .SetRequestHeader "Cache-Control", "no-cache"
            .SetRequestHeader "Authorization", "Bearer " & AuthToken
            .SetRequestHeader "REDACTED", "REDACTED"
            .Send
    End With

Set JSON = JsonConverter.ParseJson(httpReq.ResponseText)

i = 1

For Each Item In JSON
    ThisWorkbook.Sheets("DATA").Cells(i + 1, 1) = Item("id")
    ThisWorkbook.Sheets("DATA").Cells(i + 1, 2) = Item("project_id")

    If IsNull(JSON(i)("project")("name")) Then
        ThisWorkbook.Sheets("DATA").Cells(i + 1, 3) = ""
        Else: ThisWorkbook.Sheets("DATA").Cells(i + 1, 3) = JSON(i)("project")("name")
    End If

    If IsNull(JSON(i)("party")("employee_id")) Then
        ThisWorkbook.Sheets("DATA").Cells(i + 1, 4) = ""
        Else: ThisWorkbook.Sheets("DATA").Cells(i + 1, 4) = JSON(i)("party")("employee_id")
    End If

    ThisWorkbook.Sheets("DATA").Cells(i + 1, 5) = Item("date")
    ThisWorkbook.Sheets("DATA").Cells(i + 1, 6) = Item("hours")

    If IsNull(JSON(i)("party")("name")) Then
        ThisWorkbook.Sheets("DATA").Cells(i + 1, 7) = ""
        Else: ThisWorkbook.Sheets("DATA").Cells(i + 1, 7) = JSON(i)("party")("name")
    End If

    ThisWorkbook.Sheets("DATA").Cells(i + 1, 8) = Item("approval_status")

    If IsNull(JSON(i)("timecard_time_type")("time_type")) Then
        ThisWorkbook.Sheets("DATA").Cells(i + 1, 9) = ""
        Else: ThisWorkbook.Sheets("DATA").Cells(i + 1, 9) = JSON(i)("timecard_time_type")("time_type")
    End If

    i = i + 1

Next

End Sub

Everything works great until there is a null for (timecard_time_type)(time_type). As you can see, I tried the IsNull option, but because it's in a "sub-array" it doesn't seem to function.

Thanks in advance for the assistance! I'm sure I'm doing something wrong!

[Nick-vanGemeren]

Your JSON only has one JSON Array (at the top level). In VBA, that becomes a Collection. The other 'arrays' are JSON Objects, which become VBA Dictionaries.

So you have a problem with the line "timecard_time_type": null, Clearly you have to test that for null before trying to access the nested dictionary. The same applies to any other potentially null dictionary.

Excel displays null vales as an empty cell. So if you are only displaying data, no replacement is needed. But if it is, you can simplify the code with a function.

Other suggestions:

• Test the web response status before parsing.
• UseIteminstead ofJSON(i)
• Use a Range variable to refer to the current Excel row.

Something like (untested):

    Dim CurrentRow As Range
...
Set CurrentRow = ThisWorkbook.Sheets("DATA").Row(2)
For Each Item In JSON
    With CurrentRow
        .Cells(1, 1) = Item("id")
        .Cells(1, 2) = Item("project_id")
        .Cells(1, 3) = Clean(Item("project"), "name")
        .Cells(1, 4) = Clean(Item("party"), "employee_id")
        .Cells(1, 5) = Item("date")
        .Cells(1, 6) = Item("hours")
        .Cells(1, 7) = Clean(Item("party"), "name")
        .Cells(1, 8) = Item("approval_status")
        .Cells(1, 9) = Clean(Item("timecard_time_type"), "time_type")
    End With
    Set CurrentRow = CurrentRow.Offset(1, 0)
Next

End Sub

Function Clean(Jdict As Variant, Jkey As String)
    Clean = ""
    If TypeName(Jdict) <> "Dictionary" Then Exit Function
    If Not Jdict.Exists(Jkey) Then Exit Function
    If IsNull(Jdict(Jkey)) Then Exit Function
    Clean = Jdict(Jkey)
  End Function

============== If the above solves your problem, please close the issue here.

[houghtonap]

Part of your issue is that you don't understand how VBA-JSON maps JSON to VBA objects. Specifically you state that you have nested JSON Arrays, but in fact you have nested JSON Objects in a JSON Array. VBA-JSON maps JSON Arrays to VBA Collection objects and maps JSON Objects to VBA Scripting.Dictionary objects. These two objects have distinctly different interfaces. You cannot convert JavaScript brackets, i.e., obj = { a: { b: { c: null } } } ; obj["a"]["b"]["c"] === null into VBA as obj("a")("b")("c") the VBA Scripting.Dictionary object does not work the same way a JavaScript Object works. Because VBA-JSON maps JSON to VBA objects, when an VBA object does not contain a value it is the keyword Nothing which is roughly equivalent to JavaScript's null. So in VBA terms your code should look something like:

Set JSON = JsonConverter.ParseJson(httpReq.ResponseText)

If JSON is Nothing Then
    Exit Sub
End If

In addition, there is no error checking that determines you have the correct kind of object. You assume that your HTTP response will return a JSON Array which maps to a VBA Collection object. So the above code should look something like:

Set JSON = JsonConverter.ParseJson(httpReq.ResponseText)

If JSON is Nothing Then
    Exit Sub
End If

If Not TypeOf JSON Is Collection Then
    Exit Sub
End If

Given the above two type guards you can now use the variable JSON and do For Each Item In JSON. Next you need to determine whether Item is a JSON Object which VBA-JSON converted into a VBA Scripting.Dictionary object. So your code is now looking like:

Set JSON = JsonConverter.ParseJson(httpReq.ResponseText)

' Was the VBA object NULL?
If JSON is Nothing Then
    Exit Sub
End If

` Was a JSON Array found?
If Not TypeOf JSON Is Collection Then
    Exit Sub
End If

' Loop thru JSON Array.
For Each Item in JSON

    ' Was there any items in the JSON Array?
    If Item Is Nothing Then
        Exit Sub
    End If

    ' Was the JSON Array item a JSON Object?
    If Not TypeOf Item Is Scripting.Dictionary Then
        Exit Sub
    Endif

    ' Does the JSON Object contain a property named "id"?
    If Not Item.Exists("id") Then
        Exit Sub
    End If

    ' The above existence check is required before accessing a property of a VBA Scripting.Dictionary object,
    ' otherwise the VBA Scripting.Dictionary object will add the property to the hash when it is missing,
    ' thus when property "id" was not found in the original JSON Object, then saying:
    '
    '     ThisWorkbook.Sheets("DATA").Cells(i + 1, 1) = Item.Item("id")
    '
    ' would result in the property "id" begin added to hash with no value and the Excel cell would
    ' not contain a value.
    '
    ' See VBA Scripting.Dictionary reference, Item property, Remarks section:
    '     ... "If key is not found when attempting to return an existing item,
    '     a new key is created and its corresponding item is left empty."

    ThisWorkbook.Sheets("DATA").Cells(i + 1, 1) = Item.Item("id")

    ' Does the JSON Object contain a property named "project_id"?
    If Not Item.Exists("project_id") Then
        Exit Sub
    End If

    ThisWorkbook.Sheets("DATA").Cells(i + 1, 2) = Item.Item("project_id")

    ' ... rest of code restructured to check for Collection or Scripting.Dictionary objects and property names.

Next

See @Nick-vanGemeren comment which defines the Clean function to simplify your code with the necessary type guards described above.

Hope that helps.

References

• VBA Language Reference
• VBA Collection object.
• VBA Scripting.Dictionary object.

[EPiSKiNG]

Thank you both so much! This was super informative and helpful in both solving my issue at hand as well as teaching me concepts that will be useful for future issues!

So appreciated!