收到具有相同主题的新电子邮件时如何删除旧电子邮件 [英] 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屋!