Question

我有几千个项目文件夹，然后在其中包含几个文档。所有这些文件都应在文件中以明文形式包含标题，日期，发行和作者。但是不幸的是一些文件没有这个。

所以我要做的是我的循环是循环遍历所有文档，找出丢失的内容，并从文件属性中获取作者。

然后我要为每个用户打印出来：

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

所以我想做的是用用户作为键填充外部词典，并用文档名称填充内部词典（Is there any character limitation in Dictionary Keys?，完整的文件路径应作为键）

但是由于某种原因，它不起作用，它将找到所有用户，但是内部嵌套字典为空！

因此，每当我在文档中发现缺少的东西（标题，作者，问题，日期）时，我都会调用此过程：

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

然后该过程应将其添加到嵌套字典中

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

当我完成循环后，我尝试打印出结果（或通过电子邮件发送）

      ' 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

我创建了以下测试过程：

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

此输出过程：

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

输出将为

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

请注意，您必须为每个用户重新初始化outputString = ""，否则您会将所有内容从旧用户追加到下一个用户。

我发生了一件奇怪的事情：

在测试过程TestDict中有2个项目符合预期（此处一切正确）...

将字典移交给Output过程之后，它神奇地有了第三项为空：

为避免错误，我刚刚添加了If key = "" Then Exit Sub作为解决方法，但这似乎第三项很奇怪。如果有人知道为什么会发生这种情况，请发表评论。

如果我将emailDict重命名为MyDict却没有出现，但是emailDict从未被声明为public / global或其他名称。因此它以某种方式将其与addItemToDict(ByRef emailDict As Object中的字典相连接，但是我认为这不可能发生。

填充嵌套字典以方便打印

1 个答案: