Question

我无法删除具有相同主题行但在Outlook-vba上保留新收到的电子邮件的电子邮件

有没有人对如何做到这一点有任何想法？

Answer 1

在Items.Subject <中衡量收到的Item.ReceivedTime Item.ReceivedTime时，您可以使用 Dictionary Object 来存储Inbox.Items < / p>

_{Dictionary in VBA 是一个集合对象：
  你可以存储各种各样的东西：数字，文本，日期，数组，范围，变量和对象，字典中的每个项目都有自己独特的键和
  使用该键，您可以直接访问该项目（读/写）。}

现在自动化流程 - 尝试使用 Application.Startup Event (Outlook) 和 Items_ItemAdd Event (Outlook)

_{Items.ItemAdd Event 在将一个或多个项目添加到指定集合时发生。当一次将大量项目添加到文件夹时，此事件不会运行。}

代码示例

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        RemoveDupEmails Item ' call sub
    End If
End Sub

Private Sub RemoveDupEmails(ByVal Item As Object)
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder
    Dim DupItem As Object
    Dim Items As Outlook.Items
    Dim i As Long

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items

    Debug.Print Item.ReceivedTime ' Immediate Window

    Set DupItem = CreateObject("Scripting.Dictionary")
    Set Items = Inbox.Items

    Items.Sort "[ReceivedTime]"

    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is MailItem Then
            Set Item = Items(i)

            If Item.ReceivedTime >= Items(i).ReceivedTime Then

                If DupItem.Exists(Item.Subject) Then
                    Debug.Print Item.Subject ' Immediate Window
                    'Item.Delete ' UnComment to delete Item
                Else
                    DupItem.Add Item.Subject, 0
                End If

            End If

        End If
    Next i

    Set olNs = Nothing
    Set Inbox = Nothing
    Set DupItem = Nothing
    Set Items = Nothing
End Sub

如何在收到具有相同主题的新电子邮件时删除旧电子邮件

1 个答案: