来自 excel vba，只计算原始邮件

Question

我刚刚开始了解 Excel VBA，现在我需要（从 Excel）计算特定时间段内 Outlook 中的电子邮件。 我现在硬编码了那个时间框架。 该部分似乎有效 - 至少计数是正确的。

问题是它计算的是每一个 email，而不仅仅是原件。 我只需要新邮件的计数。 我查看了 .GetConversation 然后读到 conversationIDs 随每个 email 而变化，所以原来有 44 个字符。 我认为这将是过滤的好方法，但我不明白该属性中的内容，因为它不起作用。

现在我不知道我是不是找错了树，或者我是不是指日可待。 它工作正常，直到它尝试按对话 ID 进行过滤。

Sub cntEmail()
'I WILL NEVER COUNT EMAILS AGAIN, dangit
    Dim ns As Namespace: Set ns = GetNamespace(Type:="MAPI")
    Dim fldr As Folder, fldrDone As Outlook.Folder
    Dim inboxItems As Items, doneItems As Items, sFilter As String
    
    Set fldr = ns.Folders("Call Center").Folders("Inbox")
    Set fldrDone = ns.Folders("Call Center").Folders("DONE")
    Set inboxItems = fldr.Items
    Set doneItems = fldrDone.Items
    sFilter = "[LastModificationTime] > '" & Format("1/13/2023 17:00", "ddddd h:mm AMPM") & "' AND [LastModificationTime] < '" & Format("1/20/2023 16:59", "ddddd h:mm AMPM") & "'"
    Set inboxItems = inboxItems.Restrict(sFilter)
    Set doneItems = doneItems.Restrict(sFilter)
    
    Debug.Print "Total Inbox Count: " & inboxItems.Count
    Debug.Print "Total Done Count: " & doneItems.Count
    
    'Everything above this comment works

    Set inboxItems = inboxItems.Restrict("[ConversationID] < 45")
    Set doneItems = doneItems.Restrict("[ConversationID] < 45")
    
    Debug.Print "Total Inbox Count: " & inboxItems.Count
    Debug.Print "Total Done Count: " & doneItems.Count

    Set fldr = Nothing
    Set fldrDone = Nothing
    Set ns = Nothing
End Sub

Answer 1

会话ID

据我了解， ConversationID是一个属性，对于属于同一对话的所有邮件项目，该属性将具有相同的值（ 此处有更多信息）。

这意味着如果您回复 email 并且此人回复您的回复，那么您从他们那里收到的第二个 email 应该具有相同的ConversationID 。

我假设当你说你想计算“原始电子邮件”时，你的意思是你想避免计算第二个 email，因为它是由第一个（原始）email 发起的对话的一部分。

所以基本上，您想要计算您的 mailItems 中有多少个 ConversationID 的唯一值。

我没有使用.Restrict ，所以我不确定您是否可以将它用于此目的，但是有一些方法可以通过循环MailItems并计算唯一值来获取ConversationID的唯一值的总数。

---

选项 1：使用集合

一种方法是使用集合。 由于集合不能包含具有相同键的两个元素，我们可以使用它来计算唯一值的数量。

例如：

    Dim UniqueConversations As New Collection
    
    Dim inboxItem As MailItem
    For Each inboxItem In inboxItems
        On Error Resume Next
            'This line will return an error when the key already matches an item in the collection
            'and the item won't be added to the collection.
            UniqueConversations.Add 1, inboxItem.ConversationID
        On Error GoTo 0
    Next inboxItem

    Debug.Print "Total Inbox Count: " & UniqueConversations.Count

---

选项 2：使用字典

字典解决方案更优雅一些，因为我们不需要使用On error语句。

我们在使用字典时不会出错的原因是，当键已经存在于字典中时，我们只会覆盖存储的值。

例如：

    'Make sure to include Microsoft Scripting Runtime Library or use the drop-in replacement VBA-tools/VBA-Dictionary on Mac
    Dim dict As Dictionary
    Set dict = New Dictionary
    
    Dim inboxItem As MailItem
    For Each inboxItem In inboxItems
        dict.Item(inboxItem.ConversationID) = 1
    Next inboxItem
    
    Debug.Print "Total Inbox Count: " & dict.Count

如果你有很多电子邮件，字典方法通常更快，但我没有注意到我所做的小测试有什么大的不同。

Answer 2

您不能对[ConversationID] < 45之类的属性长度创建限制（您可以在扩展 MAPI 中，但它只能从 C++ 或 Delphi 获得）。 尝试限制PR_SUBJECT_PREFIX MAPI 属性为空字符串。 在回复上它是"RE"和"FW"在前锋上。

@SQL="http://schemas.microsoft.com/mapi/proptag/0x003D001F" = ''

在你的代码中：

Set inboxItems = inboxItems.Restrict("@SQL=""http://schemas.microsoft.com/mapi/proptag/0x003D001F"" = ''")
Set doneItems = doneItems.Restrict("@SQL=""http://schemas.microsoft.com/mapi/proptag/0x003D001F"" = ''")