Populate nested dictionary for nice print out

Question

I have a few thousand project folders, which then has then several documents inside them. All these documents should have title, date, Issue and Author in clear text in the document. However unfortunately some does document does not have this.

So what I am doing is that my loop does is that it loops through all documents, figure out whats missing as well as grabbing author from file-properties.

Then I want to print out for every user:

XX user you need to fix this in :
document XXX: title, date 
Document XXX: author,issue
........

So what I am trying to do is to populate the outer dictionary with user as key and the inner dictionary with document name(Is there any character limitation in Dictionary Keys?, full filepath should be ok as key)

However for some reason this does not work, it finds all user, but inner nested dictionary is empty!

So whenever i find a missing thing(title,author,issue,date) in a document I call this procedure:

Call addItemToDict(emailDict, userName, "Description of the error", doc)

then that procedure should add it to the nested dictionary:

Public Sub addItemToDict(ByRef emailDict As Object, user As String, text As String, ByRef doc As Document)
Dim temp As Object
Set temp = CreateObject("Scripting.Dictionary")
'check if user exist
If emailDict.Exists(user) Then
    Set temp = emailDict(user)

    'check if document exist
    If temp.Exists(doc.fullName) Then
        emailDict(user)(doc.fullName) = emailDict(user)(doc.fullName) & vbNewLine & text
    Else
        temp.Add doc.fullName, "Dokumentet " & embedLink(doc.fullName, doc.name) & " har mangler: " & vbNewLine & text
        Set emailDict(user) = temp

    End If
Else
    temp.Add doc.fullName, "Dokumentet " & embedLink(doc.fullName, doc.name) & " har mangler: " & vbNewLine & text
    emailDict.Add user, temp

End If

End Sub

and when I am done looping i try to print out the result(or email it)

      ' print all mistakes ...
    Dim key, key2 As Variant
    For Each key In emailDict.keys
        'we need to double check that the user really exist..
        rowMy = CPearson.findRownumber(key, Settings.userArray, 0)
        If rowMy <> -1 Then
            For Each key2 In emailDict(key).keys
      ' all mistakes....
                outputString = outputString & vbNewLine & emailDict(key)(key2)

            Next key2
            emailAddress = Settings.userArray(rowMy, 4)
            Call email.send_Email(emailAddress, "Email Subject....", _
                "Some nice intro text.... " & vbNewLine & outputString)
        End If
        Debug.Print key, emailDict(key)
    Next key

Answer 1

I created the following test procedure:

Sub test()
    Dim TestDict As Object
    Set TestDict = CreateObject("Scripting.Dictionary")

    Dim wApp As New Word.Application

    Dim testdoc As Document
    Set testdoc = wApp.Documents.Open("C:\temp\test.docx")

    addItemToDict TestDict, "User A", "Text 1", testdoc
    addItemToDict TestDict, "User A", "Text 2", testdoc
    addItemToDict TestDict, "User A", "Text 3", testdoc
    addItemToDict TestDict, "User B", "Text 1", testdoc
    addItemToDict TestDict, "User B", "Text 2", testdoc
    wApp.Quit

    Output TestDict
End Sub

And this output procedure:

Sub Output(emailDict As Variant)
    Dim outputString As String

    Dim key As Variant, key2 As Variant
    For Each key In emailDict.Keys
        If key = "" Then Exit Sub

        outputString = "" 're-initialize for each user!
        For Each key2 In emailDict(key).Keys
            outputString = outputString & vbNewLine & emailDict(key)(key2)
        Next key2

        Debug.Print key, key2, outputString
    Next key
End Sub

The output will be

User A                      
Dokumentet C:\temp\test.docx har mangler: 
Text 1
Text 2
Text 3
User B                      
Dokumentet C:\temp\test.docx har mangler: 
Text 1
Text 2

---

• Note that you must re initialize outputString = "" for each user otherwise you will append everything from the old user to the next user.

A odd thing happend to me:

While in the test procudure TestDict has 2 items as expected (everthing is correct here) …

After handing over the dictionary to the Output procedure it magically has a third item which is empty:

To avoid errors I just added If key = "" Then Exit Sub as a workaround but this appearing third item is very strange. If someone has an idea why this happens please comment.

It doesn't appear if I rename emailDict to MyDict but emailDict was never declared public/global or something. So it somhow connects it with the dictionary in addItemToDict(ByRef emailDict As Object but in my opinion this should be impossible to happen.