outlook2016设置删除重复邮件方法.txt

Sub DelDuplicateMail() '删除重复邮件
Dim olApp As Outlook.Application
Dim fld_Inbox As Outlook.Folder
Dim objItems As Outlook.Items
Dim myItem As Object
Dim dupItem As Object
Dim i%, j%
Dim ThisSenderEmailAddress, NextSenderEmailAddress As String
Dim ThisSize, NextSize As Long
Dim ThisSentOn, NextSentOn As Date
Dim ThisBody, NextBody As String
Dim st As Object

aa = Timer
Set olApp = Outlook.Application

For Each st In Application.ActiveExplorer.Selection '选择当前邮件对应的文件夹
If TypeName(st) = "MailItem" Then
Set fld_Inbox = st.Parent
Exit For
End If
Next

If TypeName(fld_Inbox) <> "MAPIFolder" Then MsgBox "请选择有效文件夹，程序退出": Exit Sub
Set objItems = fld_Inbox.Items
If objItems.Count = 1 Then MsgBox "请选择大于 1 封邮件的文件夹，程序退出": Exit Sub

'Set objItems = objItems.Restrict("[SentOn] > '8/1/2014'"
objItems.Sort "[SentOn]", True '按日期排序