7
\$\begingroup\$

Based on this SO post - also reposted on vba4all.com with a few more details and explanations.

Please notice there currently is no error handling whatsoever as I didn't analyse and consider any traps yet. Although feel free to supply details/code based on your assumptions. For Example - the code fails when you try to load duplicate keys into the dictionary... this can easily be handled with the OERN approach...

So the tree would look like this for example

enter image description here

I have created a simple procedure TraverseDictionary() which traverses any structure of dictionaries.

The simplest version that prints somehow a logical structure to the Immediate Window:

Sub Main()
 Dim dict As New Dictionary
 Dim subDict As New Dictionary
 Dim lvlDict As New Dictionary
 lvlDict.Add "LVL KEY", "LVL ITEM"
 subDict.Add "HELLO", ":)"
 subDict.Add "WORLD", ":("
 subDict.Add "OTHER", lvlDict
 dict.Add "FOO", "BAR"
 dict.Add "BOO", subDict
 TraverseDictionary dict
End Sub
Private Sub TraverseDictionary(d As Dictionary)
 For Each Key In d.Keys
 Debug.Print "KEY: " & Key
 If VarType(d(Key)) = 9 Then
 TraverseDictionary d(Key)
 Else
 Debug.Print "ITEM: " & d(Key)
 End If
 Next
End Sub

with a result:

enter image description here

and w/ a print out to sheet with somehow even more logical view

Private i As Long
Private depth As Long
Sub Main()
Cells.ClearContents
 Dim dict As New Dictionary
 Dim subDict As New Dictionary
 Dim lvlDict As New Dictionary
 lvlDict.Add "LVL KEY", "LVL ITEM"
 subDict.Add "HELLO", ":)"
 subDict.Add "WORLD", ":("
 subDict.Add "OTHER", lvlDict
 dict.Add "FOO", "BAR"
 dict.Add "BOO", subDict
 i = 1
 depth = 0
 TraverseDictionary dict
 Columns.AutoFit
End Sub
Private Sub TraverseDictionary(d As Dictionary)
 For Each Key In d.Keys
 Range("A" & i).Offset(0, depth) = "KEY: " & Key
 If VarType(d(Key)) = 9 Then
 depth = depth + 1
 TraverseDictionary d(Key)
 Else
 Range("B" & i).Offset(0, depth) = "ITEM: " & d(Key)
 End If
 i = i + 1
 Next
End Sub

enter image description here

As mr. Ioannis noticed

There is a small risk, if an Item of a dictionary is itself an object but not a dictionary. Specifically, VarType(d(Key)) = 9 holds true for Objects of any kind (I tried it with custom classes and it returned a type mismatch error). I would suggest after checking for VarType, also checking for dictionary specifically (eg, try to access a property and trap the error)

Ok, so currently the code works with the assumption that the Dictionary is actually of VarType = 9 but that breaks because of Objects which also return 9.

If we check TypeName(d(key)) = "Dictionary" then in theory it should only work with Dictionaries but can you think of any other approaches to actually check & possibly validate the Dictionary.

Side note: In the future I am most likely to create a class wrapper for this and accumulate all the checks in there along with printing at different locations and to different views.

asked Sep 19, 2014 at 11:40
\$\endgroup\$
1
  • 2
    \$\begingroup\$ This reminds me of the git object structure... \$\endgroup\$ Commented Sep 19, 2014 at 11:57

2 Answers 2

7
\$\begingroup\$

A couple of things, which you've really more or less pointed out already.

  1. You've shown us two different implementations of the same routine that outputs two two different places. I think what you really need is a class that gets initialized with an IOuput member. Then you can have different implementations of the IOuput interface, but TraverseDictionary only has to deal with IOutput and one routine can print out to anywhere.

  2. You're correct that VarType = 9 is unsafe and TypeName = "Dictionary" is safer, but I'm not sure it's entirely safe. What if there's a namespace conflict because I implemented a VBAProject.Dictionary? TypeName of my custom dict would also be "Dictionary" and who knows what would happen then. TypeOf is another option though. I've not tested it, but I believe you can do this.

    If TypeOf d(Key) Is Scripting.Dictionary Then
    

    But that means you'll also have to check IsObject(d(key)) prior to checking its actual type as well.

Update:

I finally had time to test this. I created an empty Dictionary class and ran the code below. It works.

Sub test()
 Dim dict As New Scripting.Dictionary
 Dim myDict As New VBAProject.Dictionary
 Debug.Print TypeOf dict Is Scripting.Dictionary
 'true
 Debug.Print TypeOf myDict Is Scripting.Dictionary
 'false
 Debug.Print TypeOf dict Is VBAProject.Dictionary
 'false
 Debug.Print TypeOf myDict Is VBAProject.Dictionary
 'true
End Sub
answered Sep 19, 2014 at 12:11
\$\endgroup\$
2
  • \$\begingroup\$ ++ and thanks. Your no. 2 is exactly my concern at the moment. \$\endgroup\$ Commented Sep 19, 2014 at 12:26
  • \$\begingroup\$ You're welcome. If you get to testing it before me, let me know if TypeOf can tell the difference. \$\endgroup\$ Commented Sep 19, 2014 at 12:29
4
\$\begingroup\$

In your TraverseDictionary that uses worksheets as output, you reference as global variables, i (row) and depth. You can encapsulate them in your procedure like this.

Private Sub TraverseDictionary(d As Dictionary, ByRef line As Integer, ByVal indent As Integer)
 For Each key In d.keys
 Cells(line, indent).value = key
 If VarType(d(key)) = 9 Then
 line = line + 1
 TraverseDictionary d(key), line, indent + 1
 Else
 Cells(line, indent + 1).value = d(key)
 End If
 line = line + 1
 Next
End Sub

This will allow for easier abstraction for your output. If you go with RubberDuck's solution of implementing IOutput objects they will at least need some method of controlling the depth or indentation. They should be able to control the line count on their own which will eliminate the need to keep track of it.

Private Sub TraverseDictionary(d As Dictionary, ByVal indent As Integer, ByRef ostream As IOutput)
 For Each key In d.keys
 ostream.PrintLine "Key: " & key, indent:=indent
 If VarType(d(key)) = 9 Then
 TraverseDictionary d(key), indent + 1, ostream
 Else
 ostream.PrintLine "Val: " & d(key), indent:=indent
 End If
 Next
End Sub
answered Sep 19, 2014 at 18:27
\$\endgroup\$
0

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.