这是一个创建于 2058 天前的主题,其中的信息可能已经有所发展或是发生改变。
各位先进你们好。
近期为公司领导设置了 outlook2016 收发公司自己建的邮箱,设置成 POP3。现在一台 PC 要重装,备份了 PST。重装完成,打开该 PST,并重新设置 outlook。邮箱不断收取重复的邮件(备份的 PST 有一份,再次收取一次)。
由于邮件很多,超过 3000 份,要逐一排除很困难。网上查找了很多资料,包括微软的官方技术论坛,都简单地建议下载“ outlook-duplicates-remover ”使用。可改软件需要注册,较旧的版本对中文支持也不好,邮件标题乱码。
在多次查找有,在 EXCELHOME 论坛查到以下 VB 代码:
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 '按日期排序
i = 0
For j = objItems.Count To 2 Step -1
Set myItem = objItems(j)
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(j - 1)
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
End If
End If
End If
Next
MsgBox "共删除" & i & "封邮件。运行时间为" & Format(Timer - aa, "0.00") & "秒"
End Sub
我按照说明,将其加入 outlook 开发工具那里,全选邮件后点击运行,并无作用。而 excelhome 该帖子是没有回复的,不知该代码是否真的能用?
还请各位不吝赐教。谢谢。
1 条回复 • 2019-08-19 16:12:53 +08:00
|
|
1
intuitionfly 2019-08-19 16:12:53 +08:00
可以用。我用的 outlook 2010,把宏设置成一个按钮,选中收件箱中任意一个邮件,运行宏就行了。
|