问题背景:
outlook 卸载重装后,会把之前已收的邮件,再次下载到本地,出现大量重复邮件。
解决思路:
搜索outlook邮件删除重复邮件的工具,有outlook duplicate items remover,Duplicate Email Remover,NoMoreDupes for Outlook等。但这些工具都要收费。故换了个思路,用宏来删除。
使用要点:
- 打开outlook,按快捷键Alt+F11,建立工程,并复制宏。
-
Option Explicit
Sub DeleteDuplicateEmailsInSelectedFolder()
Dim i As Long
Dim n As Long
Dim DeletedCount As Long
Dim Message As String
Dim Items As Object
Dim AppOL As Object
Dim NS As Object
Dim Folder As Object
Set Items = CreateObject("Scripting.Dictionary")
'Initialize and instance of Outlook
Set AppOL = CreateObject("Outlook.Application")
'Get the MAPI Name Space
Set NS = AppOL.GetNamespace("MAPI")
'Allow the user to select a folder in Outlook
Set Folder = NS.PickFolder
'Get the count of the number of emails in the folder
n = Folder.Items.Count
'Set the initial deleted count
DeletedCount = 0
'Check each email starting from the last and working backwards to 1
'Loop backwards to ensure that the deleting of the emails does not interfere with subsequent items in the loop
For i = n To 1 Step -1
On Error Resume Next
'Load the matching criteria to a variable
'This is setup to use the Sunject and Body, additional criteria could be added if desired
Message = Folder.Items(i).Subject & "|" & Folder.Items(i).Body
'Check a dictionary variable for a match
If Items.Exists(Message) = True Then
'If the item has previously been added then delete this duplicate
Folder.Items(i).Delete
DeletedCount = DeletedCount + 1
Else
'In the item has not been added then add it now so subsequent matches will be deleted
Items.Add Message, True
End If
Next i
ExitSub:
'Release the object variables from memory
Set Folder = Nothing
Set NS = Nothing
Set AppOL = Nothing
MsgBox "共删除" & DeletedCount & "封邮件。"
End Sub
- 然后F5运行此宏即可。
- 如果提示宏被禁用,主菜单中文件->选项->信任中心,信任中心设置->宏设置,选择“启动所有宏”或者“为所有宏提供通知”。
- 也可以通过“自定义功能区”把宏显示在主选项卡中。不过不知道为什么,点击它好像没什么反应。好在可以通过F5运行。就不去查原因了。
-
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)