VBA nested collection - dynamically get values by "nested" keys/index using variable

Question

Is it possible to retrieve a value in a nested collection consisting of multiple nested collections and arrays, using a variable?

I'm fetching data through an API in json format, and for that I'm creating a json parser (I know there are some available online, but for my own practice and interest I'm creating my own).

Beneath is a test-setup in which I've created a sample collection, consisting of multiple levels of collections and arrays.

    Dim tempColl as new collection, jsonColl as new collection, _
    tempStr as string, tempArr as variant 

    '' "temp" meaning "temporary"

    tempColl.Add "Christian", "name"
    tempColl.Add "en-us", "language"

    tempArr = Array(tempColl)

    Set tempColl = New Collection

    tempColl.Add tempArr, "person"

    jsonColl.Add tempColl, "visitors"

    '' Attempt to fetch value by using list of keys in a variable
    '' None of them is working though.

    tempStr = "(""person"")(0)(""name"")"
    Debug.Print jsonColl("visitors") & tempStr

    tempStr = "(""visitors"")(""person"")(0)(""name"")"
    Debug.Print jsonColl.tempStr

Viewing the collection in the locals window gives the following:

Question:

Is it possible to access the values using a variable like above, with another method naturally, or would I have to write out all the values I wish to get manually?

Please note that using a dictionary isn't an option as it also have to work on a Mac as well.

Tony Dallimore · Accepted Answer

Although I believe the answer I reference in my comment contains some ideas you may find interesting, I am not sure that answer is as relevant as I first thought. That OP might be dealing with arrays of unknown size, but the size was known at an early stage. I am assuming you do not know the size of your Collections and Variant Arrays and have the possibility of optional elements.

I regularly use Collections in which I nest other Collections and Arrays. But when I come to read data, the structure is fixed and known to the code at compile time. You certainly do not know the length of Collections and Arrays and might not know if an optional portion is there.

I decided it would be interesting to see if I could search nested Collections and Arrays in the way you envisage. My code in not as tidy as it could be; I encountered problems I had not expected and only re-coded as necessary to overcome those problems. I interpret you question to mean that your test data is only an example. I did not want to take the time to create polished code if the real data is likely to be significantly different.

Your parameters are of the form:

"(""visitors"")(""person"")(0)(""name"")"

I decided all these quotes were a pain to put in and a pain to take out so I changed to:

"(visitors)(person)(0)(name)"

If these quotes are essential for some reason, you can amend my code to include them.

My code starts the say as yours by building your example structure.

There are then a long list of Debug.Print statements such as:

Debug.Print "TypeName(jsonColl) " & TypeName(jsonColl)
Debug.Print "Value jsonColl(""visitors"")(""person"")(0)(""language"") " & _
          jsonColl("visitors")("person")(0)("language")

Note, these Debug.Prints include all the quotes because the VBA syntax requires them. It is my macro that does not use them. You may find these Debug.Print’s helpful if you are not familiar with the syntax necessary to access your structure. I used them to remind myself of the syntax and to ensure I had a complete understanding of your structure.

I then have:

For Each Coords In Array("(visitors)(person)(0)(name)", _
                         "(visitors)(person)(0)(language)", _
                         "visitors)(person)(0)(language)", _
                         "(visitors)(person)(0)(language", _
                         "(visitors)(person)(1)(language)", _
                         "(visitors)(person)(0)(age)", _
                         "(visitors)(person)(0)(name)(1)")
  Call GetValueFromNested(jsonColl, CStr(Coords), Value, ErrMsg)

Leaving out all the complications, each loop calls GetValueFromNested for a set of co-ordinates. The first two sets extract the name and language of your example person. All the other sets are erroneous so I could check my error handling.

For a set of co-ordinates, GetValueFromNested either returns a value or sets ErrMsg to an error message explaining why it cannot return a value.

GetValueFromNested first splits the co-ordinates into an array. So "(visitors)(person)(0)(name)" becomes: Array(visitors, person, 0, name). It then copies the Collection, jsonColl, to a local variable NestedCrnt. After this preparation, it loops for each co-ordinate.

The loop uses TypeName to identify NestedCrnt since the processing is different for Collections and Arrays. Either way it sets NestedCrnt to NestedCrnt(Coord). So with "(visitors)(person)(0)(name)":

Initial value of `NestedCrnt` is `jsonColl `
Loop 1 changes `NestedCrnt` to the value of `jsonColl(visitor)`.
Loop 2 changes `NestedCrnt` to the value of `jsonColl(visitor)(person)`.
Loop 3 changes `NestedCrnt` to the value of `jsonColl(visitor)(person)(0)`.
Loop 4 changes `NestedCrnt` to the value of `jsonColl(visitor)(person)(0)(name)`.

The final value of NestedCrnt, "Christian", is returned to the caller in Value.

All the complications are explained in the macro.

I am sure you will find deficiencies in my code because I have only tested it with your example structure. I am also sure you will need a macro named something like GetBoundsOfNested. So GetBoundsOfNested(jsonColl, "(visitor)(person)") would tell you how many people you have so you could loop from lower bound to upper bound getting their names.

Option Explicit
Sub TestJsonCollArr()

  Dim tempColl As New Collection, jsonColl As New Collection, _
      TempStr As String, tempArr As Variant
  Dim Coords As Variant
  Dim ErrMsg As String
  Dim Value As Variant

  tempColl.Add "Christian", "name"
  tempColl.Add "en-us", "language"

  tempArr = Array(tempColl)

  Set tempColl = New Collection

  tempColl.Add tempArr, "person"

  jsonColl.Add tempColl, "visitors"

  ' Output informaton about jsonColl and its elements to help understand
  ' requirement.
  Debug.Print "TypeName(jsonColl) " & TypeName(jsonColl)
  Debug.Print "jsonColl.Count " & jsonColl.Count
  Debug.Print "TypeName(jsonColl(1)) " & TypeName(jsonColl(1))
  Debug.Print "TypeName(jsonColl(""visitors"")) " & TypeName(jsonColl("visitors"))
  Debug.Print "CollKeyExists(jsonColl, ""visitors"") " & CollKeyExists(jsonColl, "visitors")
  Debug.Print "jsonColl(""visitors"").Count " & jsonColl("visitors").Count
  Debug.Print "TypeName(jsonColl(""visitors""(1))) " & TypeName(jsonColl("visitors")(1))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person""))) " & _
              TypeName(jsonColl("visitors")("person"))
  Debug.Print "Bounds jsonColl(""visitors""(1)) " & LBound(jsonColl("visitors")(1)) & _
              " to " & UBound(jsonColl("visitors")(1))
  Debug.Print "Bounds jsonColl(""visitors""(""person"")) " & _
              LBound(jsonColl("visitors")("person")) & _
              " to " & UBound(jsonColl("visitors")("person"))
  Debug.Print "TypeName(jsonColl(""visitors"")(1)(0)) " & TypeName(jsonColl("visitors")(1)(0))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)) " & _
              TypeName(jsonColl("visitors")("person")(0))
  Debug.Print "jsonColl(""visitors"")(1)(0).Count " & jsonColl("visitors")(1)(0).Count
  Debug.Print "jsonColl(""visitors"")(""person"")(0).Count " & _
              jsonColl("visitors")("person")(0).Count
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)(1)) " & _
              TypeName(jsonColl("visitors")("person")(0)(1))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)(""name"")) " & _
              TypeName(jsonColl("visitors")("person")(0)("name"))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)(""language"")) " & _
              TypeName(jsonColl("visitors")("person")(0)("language"))
  Debug.Print "Value jsonColl(""visitors"")(""person"")(0)(""name"") " & _
              jsonColl("visitors")("person")(0)("name")
  Debug.Print "Value jsonColl(""visitors"")(""person"")(0)(""language"") " & _
              jsonColl("visitors")("person")(0)("language")

  For Each Coords In Array("(visitors)(person)(0)(name)", _
                           "(visitors)(person)(0)(language)", _
                           "visitors)(person)(0)(language)", _
                           "(visitors)(person)(0)(language", _
                           "(visitors)(person)(1)(language)", _
                           "(visitors)(person)(0)(age)", _
                           "(visitors)(person)(0)(name)(1)")
    ' Note: GetValueFromNested requires the second parameter be a string but
    '       For Each requires Coords to be a Variant.  CStr converts the
    '       variant Coords to the required string.
    Call GetValueFromNested(jsonColl, CStr(Coords), Value, ErrMsg)
    Debug.Print "Coords " & Coords
    Debug.Print "Value " & Value
    Debug.Print "ErrMsg " & ErrMsg
    Debug.Print "------"
  Next

End Sub
Function GetNextElement(ByRef NestedNext As Variant, _
                        ByRef NestedElement As Variant) As Boolean

  ' Copy the value of NestedElement to NestedNext

  ' * In the call of GetNextElement, NestedElement will be an expression of the
  '   form: NestedCrnt(Index).
  ' * If both NestedCrnt and NestedElement are Collections,
  '   "Set NestedCrnt = NestedElement" will correctly copy the value of
  '   NestedElement to NestedCrnt
  ' * If NestedCrnt is a Collection and NestedElement is a Variant array, the
  '   assignment fails.  No error is given but NestedCrnt is unchanged.
  ' * This routine was coded to explore what works and what does not.
  ' * It appears the initial value of NestedCrnt does not matter.  If
  '   NestedElement is a Collection, the assignment must start with "Set".
  '   If NestedElement is a Variant Array, the "Set" must be omitted.

  Dim ErrNum As Long
  Dim NestedLocal As Variant
  Dim TypeNameExptd As String
  Dim TypeNameGot As String
  Dim TypeNameOrig As String

  TypeNameOrig = TypeName(NestedNext)
  TypeNameExptd = TypeName(NestedElement)

  'Debug.Print NestedNext("visitors")("person")(0)("language")
  'Debug.Print NestedElement("person")(0)("language")
  'Debug.Print NestedNext("person")(0)("language")
  'Debug.Print NestedElement(0)("language")
  'Debug.Print NestedNext("language")
  'Debug.Print NestedElement

  ' First get element out of NestedElement into local variable without
  ' changing NestedNext which is probably the parent of NestedElement
  On Error Resume Next
  If TypeNameOrig = "Collection" And TypeNameExptd = "Collection" Then
    Set NestedLocal = NestedElement
  ElseIf TypeNameOrig = "Variant()" And TypeNameExptd = "Variant()" Then
    NestedLocal = NestedElement
  ElseIf TypeNameOrig = "Collection" And TypeNameExptd = "Variant()" Then
    NestedLocal = NestedElement
  Else
    NestedLocal = NestedElement
  End If
  ErrNum = Err.Number
  On Error GoTo 0

  If ErrNum <> 0 Then
    GetNextElement = False
    Exit Function
  End If

  ' Now copy value from local variable to NestedNext
  On Error Resume Next
  If TypeNameOrig = "Collection" And TypeNameExptd = "Collection" Then
    Set NestedNext = NestedLocal
  ElseIf TypeNameOrig = "Variant()" And TypeNameExptd = "Variant()" Then
    NestedNext = NestedLocal
  ElseIf TypeNameOrig = "Collection" And TypeNameExptd = "Variant()" Then
    NestedNext = NestedLocal
  Else
    NestedNext = NestedLocal
  End If
  ErrNum = Err.Number
  On Error GoTo 0

  If ErrNum <> 0 Then
    GetNextElement = False
    Exit Function
  End If

  TypeNameGot = TypeName(NestedNext)

  If TypeNameExptd <> TypeNameGot Then
    GetNextElement = False
    Debug.Assert False     ' Investigate error
    Exit Function
  End If

  'Debug.Print NestedLocal("person")(0)("language")
  'Debug.Print NestedNext("person")(0)("language")
  'Debug.Print NestedLocal(0)("language")
  'Debug.Print NestedNext(0)("language")
  'Debug.Print NestedLocal
  'Debug.Print NestedNext

  GetNextElement = True

End Function
Sub GetValueFromNested(ByRef Nested As Variant, ByVal Coords As String, _
                       ByRef Value As Variant, ByRef ErrMsg As String)

  ' * If possible, set Value to the element of Nested defined by Coord
  '   and set ErrMsg = "".
  ' * If not possible, set ErrMsg to the reason it is not possible.

  ' * Nested can be a Collection, a Variant array or a regular array. "Regular"
  '   means String, Long or any other standard data type other than Variant.
  '   Elements of a Collection or a Variant array can be Collections, Variant
  '   arrays, regular array, or single values of any standard data type.
  ' * Coords is a string of the form: (Z)(Y)(X)(W)...
  '   Z identifies an element within Nested.
  '   Y identifies an element within Nested(Z).
  '   X identifies an element within Nested(Z)(Y).
  '   Coords may contain as many of Z, Y, X and so on as necessary to
  '   identify an inner element of Nested.
  '   If Z, Y, X and so on identify the element of a Collection, they may be
  '   integer position within the Collection of the key of an element.  If they
  '   identify the element of an array, they must be an integer position
  '   The inner element identified by Coord must be a single value.
  ' * Value will be set to the single value identified by Coord if Coord does
  '   identify a single value.
  ' * ErrMsg will be set to an appropriate error message if Coord does not
  '   identify a single value.  Note: ErrMsg is not intended to be intelligible to
  '   a user; it is intended to aid the developer diagnose errors in their code.

  Dim CoordParts() As String
  Dim ElmntId As String
  Dim ErrNum As Long
  Dim InxCP As Long
  Dim InxNP As Long
  Dim NestedCrnt As Variant
  Dim StrTemp As String
  Dim TypeNameCrnt As String

  Value = ""
  ErrMsg = ""
  ElmntId = "Nested"

  ' Split Coords into its components
  If Left$(Coords, 1) <> "(" Or Right$(Coords, 1) <> ")" Then
    ErrMsg = "Coords must start with a ( and end with a )"
    Exit Sub
  End If
  ' Any futher errors in Coords will be identified by the failure to
  ' find an element or sub-element of Nested.
  Coords = Mid$(Coords, 2, Len(Coords) - 2) ' Strip off leading and trailing paratheses
  CoordParts = Split(Coords, ")(")

  Set NestedCrnt = Nested

  For InxCP = LBound(CoordParts) To UBound(CoordParts)
    TypeNameCrnt = TypeName(NestedCrnt)
    Select Case TypeNameCrnt
      Case "Collection"
        ' CoordParts(InxCP) can be a key or an integer position
        If IsNumeric(CoordParts(InxCP)) And _
           InStr(1, CoordParts(InxCP), ".") = 0 Then
          ' CoordParts(InxCP) is an integer position
          If Not GetNextElement(NestedCrnt, NestedCrnt(CLng(CoordParts(InxCP)))) Then
            ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                     ". Valid indices are in the range 1 to " & NestedCrnt.Count
            Exit Sub
          End If
        Else
          ' CoordParts(InxCP) is a key or invalid
          On Error Resume Next
          StrTemp = TypeName(NestedCrnt(CoordParts(InxCP)))
          ErrNum = Err.Number
          On Error GoTo 0
          If ErrNum = 0 Then
            If Not GetNextElement(NestedCrnt, NestedCrnt(CoordParts(InxCP))) Then
              ErrMsg = "No element of " & ElmntId & " has a key of """ & _
                       CoordParts(InxCP) & """"
              Exit Sub
            End If
          Else
            ErrMsg = "No element of " & ElmntId & " has a key of """ & _
                     CoordParts(InxCP) & """"
            Exit Sub
          End If
        End If
      Case "Variant()"
        ' CoordParts(InxCP) can only be an integer position
        If IsNumeric(CoordParts(InxCP)) And _
           InStr(1, CoordParts(InxCP), ".") = 0 Then
          ' CoordParts(InxCP) is an integer position
          If CoordParts(InxCP) >= LBound(NestedCrnt) And _
             CoordParts(InxCP) <= UBound(NestedCrnt) Then
            Set NestedCrnt = NestedCrnt(CLng(CoordParts(InxCP)))
          Else
            ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                     ". Valid indices are in the range " & _
                     LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
            Exit Sub
          End If
        Else
          ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                   ". Valid indices are integers in the range " & _
                   LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
          Exit Sub
        End If
      Case Else
        ' Only valid values are of the form "Xxxxx()" where "Xxxxx" is a
        ' standard data type.  Should perhaps validate "Xxxxx" but have not.
        If Right$(TypeNameCrnt, 2) = "()" Then
          ' Have an array. CoordParts(InxCP) can only be an integer position
          If IsNumeric(CoordParts(InxCP)) And _
             InStr(1, CoordParts(InxCP), ".") = 0 Then
            ' CoordParts(InxCP) is an integer position
            If CoordParts(InxCP) >= LBound(NestedCrnt) And _
               CoordParts(InxCP) <= UBound(NestedCrnt) Then
              Set NestedCrnt = NestedCrnt(CLng(CoordParts(InxCP)))
            Else
              ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                       ". Valid indices are in the range " & _
                       LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
              Exit Sub
            End If
          Else
            ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                     ". Valid indices are integers in the range " & _
                     LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
            Exit Sub
          End If
        Else
          ErrMsg = "There is no element " & CoordParts(InxCP) & " of " & _
                   ElmntId & vbLf & " because " & ElmntId & _
                   " is not a Collection or an Array"
          Exit Sub
        End If

    End Select

    ElmntId = ElmntId & "(" & CoordParts(InxCP) & ")"

  Next

  If NestedCrnt = "" Then
    ' An empty string is a permitted value
    Value = ""
  Else
    TypeNameCrnt = TypeName(NestedCrnt)
    If TypeNameCrnt = "Collection" Then
      ErrMsg = ElmntId & " is a Collection when it should be a single value"
    ElseIf Right$(TypeNameCrnt, 2) = "()" Then
      ErrMsg = ElmntId & " is an Array when it should be a single value"
    Else
      Value = NestedCrnt
    End If
  End If

End Sub
Function CollKeyExists(Coll As Collection, Key As String) As Boolean

  Dim ErrNum As Long
  Dim TempStr As String

  On Error Resume Next
  TempStr = TypeName(Coll(Key))
  ErrNum = Err.Number
  On Error GoTo 0
  If ErrNum = 0 Then
    CollKeyExists = True
  Else
    CollKeyExists = False
  End If

End Function

VBA nested collection - dynamically get values by "nested" keys/index using variable

Answers (1)

Related Questions

VBA nested collection - dynamically get values by &quot;nested&quot; keys/index using variable

Answers (1)

Related Questions

VBA nested collection - dynamically get values by "nested" keys/index using variable