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

How to delete old emails when a new email with the same subject is being received

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

有人知道怎么做吗?

您可以使用 Dictionary Object 来存储 Items.Subject,同时在 Item.ReceivedTime 中测量收到的 Item.ReceivedTime =14=]


Dictionary in VBA is a collection-object: you can store all kinds of things in it: numbers, texts, dates, arrays, ranges, variables and objects, Every item in a Dictionary gets its own unique key and With that key you can get direct access to the item (reading/writing).


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

Items.ItemAdd Event Occurs when one or more Items are added to the specified collection. This event does not run when a large number of items are added to the folder at once.


代码示例

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