Keys in JSON / VBA

Question

hope someone as a little hint for me solving my problem.

I have a Json response like this:

"modules": [
    {
        "localId": "598d58882e00008b1174fa0a",
        "legs": [
            {
                "markerIndex": 0,
                "localId": "5a2ec9db250000cc0189fbac",
                "connections": [
                    {
                        "jsonClass": "TransitCO",
                        "localId": "5a882b0b26000039187fd0bb",
    {
        "localId": "598d58c82c00005411c4a7e1",
        "returnConnections": [
            {
                "jsonClass": "ActivityElementCO",
                "localId": "5a8aeacc250000641c1d389a",
    {
        "localId": "598d58d62e0000a71174fa0c",
        "legs": [
            {
                "markerIndex": 1,
                "localId": "5a85c668200000ea1b040503",
                "connections": [
                    {
                        "jsonClass": "TransitCO",
                        "localId": "5a882b0b26000039187fd0be",

I can locate 1 localId by calling:

Dim fd As Integer
Set var_dmc = JsonConverter.ParseJson(MyDMC.ResponseText)
Set dmc = Worksheets("dmc")
fd = 25
For Each item In var_dmc("modules")(1)("legs")
dmc.Cells(fd, 2) = item("connections")("localId")
fd = fd + 1
Next

Now my VBA code should read out each "localId" under "connections" IF "jsonClass" is = TransitCO.

Tried with each for and coombinations of "if then"s but nothing works.

Any ideas?

Kind regards, Chris

Answer 1

Here is a lengthy answer. There is are a lot of empty structure within the JSON (maybe due to edit. But I have coded to show how you would still access though have commented out many of these sections. The commented out typename statements are to show you what structures are being returned at each stage.

Admittedly, this is currently everything so I will look to a shorter version.

Note: I am reading the JSON in from a file on my desktop.

For a better understanding of this see my answer to this question.

Option Explicit

Sub GetValues()
    'Tools references > ms scripting runtime
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject

    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile(ThisWorkbook.Path & Application.PathSeparator & "SOQuestion.txt", ForReading)

    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Json As Object

    Set Json = ParseJson(JsonText)

    Dim col As Collection
    Set col = Json("modules")

    'Debug.Print col.Count '3 items
    Dim item As Variant
    Dim key1 As Variant
    Dim item1 As Variant
    Dim key2 As Variant

    For Each item In col

        For Each key1 In item.Keys

            If key1 = "localId" Then

                Debug.Print key1 & " : " & item(key1)

            ElseIf key1 = "legs" Then            'collection

                For Each item1 In item(key1)

                    'Debug.Print TypeName(item1) '2 dict

                    For Each key2 In item1.Keys
                        '  Debug.Print TypeName(item1(key2)) ' 2 collection; 2 dict; 4 double; 6 string

                        Dim dataStructure As String

                        dataStructure = TypeName(item1(key2))

                        Select Case dataStructure

                        Case "Double", "String"

                            Debug.Print key1 & " : " & key2 & item1(key2)

                        Case "Dictionary"

                            Dim key3 As Variant

                            For Each key3 In item1(key2).Keys

                                'Debug.Print item1(key2)(key3) 'This is empty

                            Next key3

                        Case "Collection"        ' 2 collections with 1 item which are both dictionaries

                            Dim key4 As Variant

                            For Each key4 In item1(key2)(1).Keys

                                'Debug.Print TypeName(item1(key2)(1)(key4)) ' 1 boolean; 2 collection ; 2 dict; 8 strings

                                Dim dataStructure2 As String
                                dataStructure2 = TypeName(item1(key2)(1)(key4))

                                Select Case dataStructure2

                                Case "Boolean", "String"

                                    Debug.Print key1 & " : " & key2 & " : " & key4 & " : " & item1(key2)(1)(key4)

                                Case "Collection" 'These are empty. As seen with  Debug.Print item1(key2)(1)(key4).Count

                                    '                                   Dim item2 As Variant
                                    '
                                    '                                   For Each item2 In item1(key2)(1)(key4)
                                    '
                                    '                                      ' Debug.Print TypeName(item1(key2)(1)(key4)(item2)) 'empty
                                    '                                       'Debug.Print key1 & " : " & key2 & " : " & key4 & " : " & item1(key2)(1)(key4)(item2)
                                    '
                                    '                                   Next item2

                                Case "Dictionary" 'these are empty

                                    'Dim key5 As Variant

                                    'Debug.Print item1(key2)(1)(key4).Count = 0; so; both; Empty

                                    '                                   For Each key5 In item1(key2)(1)(key4).Keys
                                    '
                                    '                                       Debug.Print TypeName(item1(key2)(1)(key4)(key5))
                                    '
                                    '                                   Next key5



                                End Select

                            Next key4

                        End Select

                    Next key2

                Next item1

            End If

        Next key1

    Next item

End Sub

And lazier, less robust, targeted version:

Option Explicit

Sub GetvaluesDict()
    'Tools references > ms scripting runtime

    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject

    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile(ThisWorkbook.Path & Application.PathSeparator & "SOQuestion.txt", ForReading)

    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Json As Object

    Set Json = ParseJson(JsonText)

    Dim col As Collection
    Set col = Json("modules")

    Dim counter As Long
    Dim dict As Dictionary

    Set dict = New Dictionary

    Dim item As Variant

    For Each item In col                         'looking at items

        Dim key1 As Variant

        For Each key1 In item.Keys

            If key1 = "returnConnections" Or key1 = "legs" Then '6 collections

                Dim item1 As Variant

                For Each item1 In item(key1)     ' 6 dictionaries

                    Dim key2 As Variant

                    For Each key2 In item1.Keys

                        Dim dataStructure As String

                        dataStructure = TypeName(item1(key2))

                        Select Case dataStructure

                        Case "Double", "String", "Boolean"
                            counter = counter + 1
                            dict.Add counter, key1 & " : " & key2 & " : " & item1(key2)

                        Case "Collection"

                            Dim item2 As Variant

                            For Each item2 In item1(key2)

                                Dim key3 As Variant

                                For Each key3 In item2.Keys

                                    Select Case TypeName(item2(key3))

                                    Case "String"

                                        counter = counter + 1
                                        dict.Add counter, key1 & " : " & key2 & " : " & key3 & " : " & item2(key3)

                                    End Select

                                Next key3

                            Next item2


                        End Select

                    Next key2

                Next item1

            End If

        Next key1

    Next item

    Dim returns As Variant

    counter = 1

    For Each returns In dict.Keys

        If InStr(1, dict(returns), "TransitCO", vbBinaryCompare) > 0 Then

            Debug.Print dict(returns) & vbTab & dict(counter + 1)

        End If
        counter = counter + 1
    Next returns

End Sub