Outlook 自动删除重复邮件VBA脚本

Outlook 2023-01-11

OUTLOOK自动删除重复邮件脚本

Sub DeleteMail()
'outLook2007版本验证！使用前请调低宏安全性
Dim olApp As New Outlook.Application
Dim fld_Inbox As Outlook.Folder
Dim objItems As Outlook.Items
Dim myItem As Object
Dim dupItem As Object
Dim i As Long
Dim ThisSenderEmailAddress, NextSenderEmailAddress As String
Dim ThisSize, NextSize As Long
Dim ThisSentOn, NextSentOn As Date
Dim ThisBody, NextBody As String

Set fld_Inbox = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set objItems = fld_Inbox.Items
'按发信时间过滤邮件列表，
'Set objItems = objItems.Restrict("[SentOn] > '8/1/2014'")

objItems.Sort "[SentOn]", True
Set myItem = objItems.GetFirst

i = 0
Do While TypeName(myItem) <> "Nothing"
If TypeName(myItem) = "MailItem" Then
ThisSenderEmailAddress = myItem.SenderEmailAddress '发件人邮箱
ThisSize = myItem.Size '邮件大小
ThisSentOn = myItem.SentOn '发信时间,如"2015/8/28 9:57:02"
ThisBody = myItem.Body '邮件文本内容

Set dupItem = objItems.GetNext
If TypeName(dupItem) = "MailItem" Then
NextSenderEmailAddress = dupItem.SenderEmailAddress
NextSize = dupItem.Size
NextSentOn = dupItem.SentOn
NextBody = dupItem.Body

'删除发件人、发信时间和邮件内容完全相同的邮件
If ThisSenderEmailAddress = NextSenderEmailAddress And ThisSentOn = NextSentOn And ThisBody = NextBody Then
dupItem.Delete
i = i + 1
Else
Set myItem = dupItem
End If

Else
Set myItem = dupItem
End If
Else
Set myItem = objItems.GetNext
End If
Loop
End Sub

Outlook 自动删除重复邮件VBA脚本的下载地址：
本地下载

上一篇：OutLook 编程下一篇：Outlook VBA自动处理邮件

Outlook 自动删除重复邮件VBA脚本

Outlook 自动删除重复邮件VBA脚本的下载地址：
本地下载

热门文章

最新文章

标签列表

Outlook 自动删除重复邮件VBA脚本

Outlook 自动删除重复邮件VBA脚本的下载地址： 本地下载

热门文章

最新文章

标签列表

Outlook 自动删除重复邮件VBA脚本的下载地址：
本地下载