A client had many duplicates in one folder and while there are a number of duplicate remover utilities, any of which work great if you need to check multiple folders for duplicates, he just needed to check one folder. He didn't want to install a utility but there were too many duplicates to manually remove them.
The solution: a macro that moves duplicate messages to a subfolder for review.
This macro is slow. If you have a lot of messages in the folder, expect it to take some time to run. See Duplicate Remover Tools for third party utilties.
To use, select a folder that needs checked for duplicates and run the macro. The macro will create a subfolder named Duplicates and move the duplicate messages to it. After reviewing the duplicates, delete the folder.
Public Sub MoveDuplicates() Dim objOL As Outlook.Application Dim objFolder As Outlook.MAPIFolder Dim objDupFolder As Outlook.MAPIFolder Dim objDictionary As Object Dim i As Long Dim objItem As Object Dim strKey As String Set objOL = Outlook.Application Set objDictionary = CreateObject("scripting.dictionary") Set objFolder = objOL.ActiveExplorer.currentFolder On Error Resume Next Set objDupFolder = objFolder.Folders.Item("Duplicates") If objDupFolder Is Nothing Then Set objDupFolder = objFolder.Folders.Add("Duplicates") End If For i = objFolder.Items.count To 1 Step -1 Set objItem = objFolder.Items.Item(i) 'Only check email items type If InStr(1, objItem.MessageClass) <> "IPM.Schedule" Then strKey = objItem.Subject & "," & objItem.Body & "," & objItem.SentOn strKey = Replace(strKey, ", ", Chr(32)) If objDictionary.Exists(strKey) = True Then objItem.Move objDupFolder ' use this to delete immediately ' objItem.Delete Else objDictionary.Add strKey, True End If End If Next i End Sub
How to use the macros on this page
First: You need to have macro security set to the lowest setting, Enable all macros during testing. The macros will not work with the top two options that disable all macros or unsigned macros. You could choose the option Notification for all macros, then accept it each time you restart Outlook, however, because it's somewhat hard to sneak macros into Outlook (unlike in Word and Excel), allowing all macros is safe, especially during the testing phase. You can sign the macro when it is finished and change the macro security to notify.
To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
The macros on this page should be placed in a module.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
More Information
See Duplicate Remover Tools for third party utilities that will be somewhat faster and have more features.
Thanks!!! Just what I needed! You saved me a lot of work! You're my hero! And thanks for also explaining what the Outlook clean up function does.
There are some tips for Outlook Delete Duplicate Emails ;
Clean up was not designed to remove duplicates - it cleans up redundant messages in threads. For example, if you have a long thread back and forth with each person quoting the messages in full, all messages in the thread except for the last one will be cleaned up.
Hi, Thank you this is just what I was looking for.
because Instr normally takes two string arguments after the start position.Puzzled by the line
InStr([ start ], string1, string2, [ compare ])
Thanks again.
This should also work -
If looking for true -
if InStr(1, objItem.MessageClass, "IPM.Schedule")
if looking for not true -
If InStr(1, objItem.MessageClass, "IPM.Schedule") = 0 Then
below message appears whenever i try to run it:
user-defined type not defined
if you click debug, which line does it stop on? That error usually means a reference to another object model is not set, but this macro doesn't use other references.
Hello, your code works amazingly.
Do you think it's possible that instead of moving duplicates to a new folder to have them marked/labeled with a color tab to be able to visually check the detected duplicates before deleting them?
You are a life saver
Sure. Change this line:
objItem.Move objDupFolder
to
objItem.categories = "duplicate"
hello, is it possible to edit it to delete the duplicated message from the inbox instead of the subfolder (keep the message in the subfolder safe)
It's moving the dupe to the subfolder - you can delete it instead.
If objDictionary.Exists(strKey) = True Then
objItem.Move objDupFolder
' use this to delete immediately
' objItem.Delete
Else
Copied/Pasted, worked like a charm. Thx a lot
Hi Diane,
Im Yogesh and i work as an Business analyst - hence i keep recieving a lot of automated reports from our different sources - and i have set rusel for all of them to be seggregated and moved to different folders - however some times there are emails / reports with same subject line and sender that get moved to multiple different folders (obviously because of the rules i set in incorrect order - which i must admit im lazy to fix) . hence i was checking if i can get a macro to check all folders and its subfolders for the emails with same Subject - Time - Sender & Body and delete any of them - the macro is BBOOS here to decide.
Im Ok with any 1 copy staying there for my reference.
is it possible ? or am i asking for too much from a macro ..!
thanks a ton for the current one too ...!
it would be very slow to check all folders - an addin would be more efficient - still slow, but faster because its complied.