收到具有相同主题的新电子邮件时如何删除旧电子邮件 [英] How to delete old emails when a new email with the same subject is being received

问题描述

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

I'm Having trouble deleting Emails with same subject line but keeping the newly received Email on Outlook-vba

有人对此有任何想法吗?

Does anyone have any ideas on how to do that?

推荐答案

您可以使用

You can work with Dictionary Object to Store Items.Subject while you measure the received Item.ReceivedTime with Item.ReceivedTime in your Inbox.Items

VBA中的词典 是一个收集对象: 您可以在其中存储各种内容:数字，文本，日期，数组，范围，变量和对象，字典中的每个项目都有自己的唯一键， 使用该键，您可以直接访问该项目(读/写).

_{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).}

---

现在要使过程自动化-尝试使用 应用程序.Startup Event(Outlook) 和

---

Now to Automate the process - Try working with Application.Startup Event (Outlook) And Items_ItemAdd Event (Outlook)

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

_{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

这篇关于收到具有相同主题的新电子邮件时如何删除旧电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！