Dynamically Add To Nested Dictionary

101 Views Asked by At

Is it possible to dynamically access/edit a nested dictionary with a "path" to that dictionary's parents?

So I am creating a dictionary of assemblies and parts, the assemblies have 'children' assemblies and parts and those assemblies have 'children' assemblies and parts...

I have a sub that generates the dictionary of children and produces childrenDocsDict

I have the dictionary that will contain all the parts nested in their assemblies allDocsDict

I have a collection that contains the path to get to the nested dictionary pathCol

Private Sub addToDictViaPath(childrenDocsDict As Dictionary, ByRef allDocsDict As Dictionary, pathCol As Collection)
Select Case pathCol.Count
    Case Is = 1
        Set allDocsDict(pathCol(1))("children") = childrenDocsDict
    Case Is = 2
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children") = childrenDocsDict
    Case Is = 3
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children") = childrenDocsDict
    Case Is = 4
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children") = childrenDocsDict
    Case Is = 5
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children")(pathCol(5))("children") = childrenDocsDict
    Case Is = 6
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children")(pathCol(5))("children")(pathCol(6))("children") = childrenDocsDict
    Case Is = 7
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children")(pathCol(5))("children")(pathCol(6))("children")(pathCol(7))("children") = childrenDocsDict
    Case Is = 8
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children")(pathCol(5))("children")(pathCol(6))("children")(pathCol(7))("children")(pathCol(8))("children") = childrenDocsDict
    Case Is = 9
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children")(pathCol(5))("children")(pathCol(6))("children")(pathCol(7))("children")(pathCol(8))("children")(pathCol(9))("children") = childrenDocsDict
    Case Is = 10
        Set allDocsDict(pathCol(1))("children")(pathCol(2))("children")(pathCol(3))("children")(pathCol(4))("children")(pathCol(5))("children")(pathCol(6))("children")(pathCol(7))("children")(pathCol(8))("children")(pathCol(9))("children")(pathCol(9))("children") = childrenDocsDict
End Select 
End Sub

This works but as you can see it's not exactly ideal. Is there a way to do this using some sort of recursive function?

(I'm fairly new to programming and self taught from reading documentation and there could be a huge blind spot in my knowledge, so please enlighten me!)

2

There are 2 best solutions below

0
Tim Williams On

Can't quite figure out your dictionary structure, but I think it's easier to use a function to access your nested sub-item, and then do whatever you need with it.

Sub Tester()
    
    Dim dictTop As Object, dict As Object, dictsub As Object, lvl As Long
    
    Set dictTop = CreateObject("scripting.dictionary")
    Set dict = dictTop
    
    For lvl = 1 To 5
        dict.Add "L" & lvl & "_key1", "info"
        dict.Add "L" & lvl & "_key2", CreateObject("scripting.dictionary")
        Set dict = dict("L" & lvl & "_key2")
    Next lvl
    
    'show structure
    Dump dictTop
    
    'access a nested dictionary
    Set dictsub = GetNestedObject(dictTop, "L1_key2/L2_key2/L3_key2")
    Dump dictsub

End Sub

'return a nested dictionary object using a "/"-delimited path
Private Function GetNestedObject(dict As dictionary, path As String)
    Dim i As Long, d As Object, arr, obj, k
    path = Replace(path, "\", "/")   'just in case...
    arr = Split(path, "/")
    Set obj = dict
    For i = LBound(arr) To UBound(arr)
        k = arr(i)
        Set obj = obj(k)
    Next i
    Set GetNestedObject = obj
End Function

'write out dictionary content (scalar value and dictionary values only)
Sub Dump(dict As Object, Optional lvl As Long = 1)
    Dim k, pad, el
    pad = String(lvl * 3, " ")
    If lvl = 1 Then Debug.Print vbLf & "******************"
    For Each k In dict.Keys
        Select Case TypeName(dict(k))
            Case "Dictionary"
                Debug.Print pad & k & " : (dictionary)"
                Dump dict(k), lvl + 1
            Case Else
                Debug.Print pad & k & " : " & dict(k)
        End Select
    Next k
End Sub

0
FaneDuru On

To do what you asked it shouldn't be so complicated. You already received an answer.

But I usually try helping if I understand what you really try accomplishing and you show only a slice of the project. Please, look to the next (didactic) code to understand how such an issue can be treated only using dictionaries. A dictionaries tree...

Of course, the workbook keeping the code needs a reference to 'Microsoft Scripting Runtime`:

Private Sub DictionariesTree()
  Dim i As Long, j As Long, k As Long, dict As New Scripting.Dictionary
  
  For i = 1 To 2 'iterate between the existing assembleis
    dict.Add "A" & i, New Scripting.Dictionary
    For j = 1 To 5 'add the sub assembleis to each assembley:
        dict("A" & i).Add "S" & i & j, New Scripting.Dictionary
        For k = 1 To 2 'add the sub subassembeles to each sub assembley:
          dict("A" & i)("S" & i & j).Add "S" & i & j & k, "SS" & i & j & k 'place a concatenated string as item
        Next k
    Next j
  Next i
  
  'Test returning from the above dictionary tree:
  'directly call specifying the keys string:
  Debug.Print dict("A1")("S11")("S111"), dict("A2")("S21")("S211")
  
  'return each tree dictionary number of elements:
  Debug.Print dict("A1").count, dict("A2").count, dict("A1")("S11").count, dict("A2")("S21").count
  
  'return all items by iteration:
  For i = 0 To dict.count - 1
    For j = 0 To dict.Items()(i).count - 1
        For k = 0 To dict.Items()(i).Items()(j).count - 1
            Debug.Print dict.Items()(i).Items()(j).Items()(k) & " ";
        Next k
    Next j
  Next i
  
  Debug.Print
  'return assambleys, subassambleys, subsubassembleys using dictionary keys:
  Dim key1, key2, key3
  For Each key1 In dict.keys
        Debug.Print "Assembleys key: " & key1
        For Each key2 In dict(key1).keys
            Debug.Print "  Subassembleys key: " & key2
            For Each key3 In dict(key1)(key2).keys
               Debug.Print "    Sub Subassembleys key  item: " & key3, dict(key1)(key2)(key3)
            Next
        Next
  Next
End Sub

Loading it by iteration is only a way to show how it can be loaded in a tree having a simetric definition. Like the one I tried describing in my comment. It cam be loaded asimetric, according to your needs. And the items dictionaries may receive the keys names according to your wish for being more eloquent...