It happens — duplicates on Outlook. Mostly when you tried to backup and restore your Outlook files, or simply have switched servers, or whatsoever.
Outlook maybe the worst and outdated email client in the worlds, as it has no duplicate filter. That’s why you have take things into your own hands.
If you are already tried or read about other solutions, let me spare your time. These methods below don’t work:
- Doesn’t work: Remove Duplicates by Export/Import PST Files
You may have realized that when you export outlook data as PST, there is a feature asking you that you don’t export/import duplicates. Well, guess what. Outlook does it anyway. Didn’t help at all. I have exported without duplicates. Then imported without duplicates. And what I got in the end? Duplicates! Thanks, Microsoft for wasting my time! - Doesn’t work for me: Buy a tool that does it for you?
Sure, why not spent $40 or more to remove duplicates — a standard feature on almost every decent mailer has. Thanks, but no thanks.
This does work — in 5 minutes!
Below is the solution. With only one simple action, you can make duplicates disappear — it’s like a magic trick!
Step 1: Preparations
Go to File at the menu and click at “Options”, then go to “Trust Center”, click “Trust Center Settings”, in there click “Macro Settings” and select “Notification for all macros” like this:
Step 2: Copy & Paste A Script
Now you are going to write a script — or better: You will copy & paste the script I’m providing below. Don’t be scared — it’s dead easy! I’ll tell you exactly how.
Press ALT+F11.
If a security warning pops up called “Microsoft Outlook Security Notice”, just press “Enable Macros” to continue.
A new windows should open up called “Microsoft Visual Basic for Applications” that should look like this — don’t be scared. This is a lifesaver!
All you have to do now is to go to “Microsoft Outlook Objects”, press right mouse button, then go to “Insert” and then “Module”. Look below, it’s super easy:
A new window should appear on the left side. Now put this code in there:
Sub RemoveDuplicateItems() Dim objFolder As Folder Dim objDictionary As Object Dim i As Long Dim objItem As Object Dim strKey As String Set objDictionary = CreateObject("scripting.dictionary") 'Select a source folder Set objFolder = Outlook.Application.Session.PickFolder If Not (objFolder Is Nothing) Then For i = objFolder.Items.Count To 1 Step -1 Set objItem = objFolder.Items.Item(i) Select Case objFolder.DefaultItemType 'Check email subject, body and sent time Case olMailItem strKey = objItem.Subject & "," & objItem.Body & "," & objItem.SentOn 'Check appointment subject, start time, duration, location and body Case olAppointmentItem strKey = objItem.Subject & "," & objItem.Start & "," & objItem.Duration & "," & objItem.Location & "," & objItem.Body 'Check contact full name and email address Case olContactItem strKey = objItem.FullName & "," & objItem.Email1Address & "," & objItem.Email2Address & "," & objItem.Email3Address 'Check task subject, start date, due date and body Case olTaskItem strKey = objItem.Subject & "," & objItem.StartDate & "," & objItem.DueDate & "," & objItem.Body End Select strKey = Replace(strKey, ", ", Chr(32)) 'Remove the duplicate items If objDictionary.Exists(strKey) = True Then objItem.Delete Else objDictionary.Add strKey, True End If Next i End If End Sub
This is how it should look like on your end:
Step 3: Run that script!
That’s it! Run the script and duplicates inside this folder will disappear. How to run the script? Easy — see that “Run” feature on the menu… it’s this one here:
Now it will ask which folder. Select the folder you want the duplicates to be removed from.
Done!
If you liked this, please give me a nice comment on the bottom of the page. Thank you!
Hi, also getting runtime 438 error.
this line is highlighted when i click debug
strKey = objItem.Subject & “,” & objItem.Body & “,” & objItem.SentOn
Great tool! Worked like a charm in the Office 365 Outlook (pst file)! I would like to publish your script on my blog (with mentioning the source), because this piece of gold should be as public as it can be!
Fantastic — thank you!
Can I do something similar to strip attachments from IMAP e-mails?
It seems that others are getting resulting a confirmation of emails, calendars, and contacts removed. I receive no confirmation. Cannot determine what I am doing in erroror or does it not actually provide the result?
Thank you
It doesn’t work. Nothing happens (Outlook 365, Windows 10) when I run the script. No duplicates are removed. Any suggestions?
Amazing. So simple and it worked perfectly. Thank you for sharing this! This is what the Internet is all about. Vielen Dank.
Fantastic.
Perfect. Just what I needed. THANK YOU! It worked flawlessly and I could delete over 2500 duplicate messages (due to Outlook not importing the old Gmail tags…).
I could finally declutter my inbox easily and without spending money for “tools” that could not even find any duplicates. You saved my day.
Thank you for posting this. I benefited from it and was able to get rid of duplicated mails. You saved me a lot of time and headache!
Great stuff!
Works as promised and quickly.
Thanks very much for sharing the clean, simple code.
You are my hero!!!! thanks for the code. It saved my life.
Works like a dream
Hi guys,
I’m late to discussion. The error 438 was resolved and the script worked perfectly for small folder. But when I chose my main folder (over 30GB) , i get runtime error ‘430’: Class does not support automation or does not support expected interface.
Can someone please help ? Im very new to macros.
Thank you for this script. I’ve been moving to a new computer and decided to go IMAP instead of POP. I accidentally imported one PST into the wrong account. I figured, no problem, I’ll just delete the accounts and re-do it. Well, I ended up with duplicates. Then tried the export/import without duplicates and ended up with triplicates or quadruplicates. All synced to my webhost. Looked into the tools, but when the grammar isn’t correct, I get uneasy. Then I saw this. Had a coder friend give it the once-over and then followed your very clear instructions and cleaned up my 3-year-old stash of emails. Well, “clean” may be debatable. But it is definitely de-duped. Thank you!
Does this routine permanently and irrevocably delete what it thinks to be duplicates or does it just move them to the deleted-items folder where they may be reviewed before being dumped (or restored)?
Many, many thanks, exactly what I was looking for and it works perfectly once I’d sorted out the characters, as follows;
For those struggling to get it to work;
Back in the day I used to do a lot of VBA programming and like most amateurs I borrowed huge amounts of code from people who were kind enough to share it on the web, and one thing I learned was this. Sometimes when you copy and paste code from the web certain characters get pasted in a different format. I don’t know why, I imagine it’s something to do with html, but it’s usually characters like ” or , or ‘ rather than letters or numbers.
If you re-type these characters one by one the code should run. Basically you should end up with blue & black text (the code) and green text (remarks, which are preceded by the ‘ symbol). alternatively you can preface each remark line with REM and it’ll do the same job. If you have any red text it means the prog can’t make any sense of that line (it’s probably a remark so add REM at the beginning of the line).
Also, don’t be afraid to use ‘debug’ if it stalls. It’ll highlight the offending characters.
By the way, in case you’re wondering whether this is some kind of sneaky virus or trojan, it’s not – that was the first thing I looked for! It’s also surprisingly quick to run – I’ve just cleaned up a 5Gb archive in a few minutes, where a server issue meant I’d created up to 5 duplicates making the files almost unmanageable.
Very Good It does what it promises!
Just do that in original code: (Line 19: replace objItem.SentOn with objItem.CreationTime), works perfectly. Thanks a lot!
I’m not getting any of this to work. Just reset Windows 10, everything new, accidently imported pst without killing dupes. This is Office 365 so it is creating OST files. The first set of code gets te 438 error, the second is just a mess.
Updated script for “Run-time error ‘438’: Object doesn’t support this property or method” (Line 19: replace objItem.SentOn with objItem.CreationTime):
Sub RemoveDuplicateItems()
Dim objFolder As Folder
Dim objDictionary As Object
Dim i As Long
Dim objItem As Object
Dim strKey As String
Set objDictionary = CreateObject(“scripting.dictionary”)
‘Select a source folder
Set objFolder = Outlook.Application.Session.PickFolder
If Not (objFolder Is Nothing) Then
For i = objFolder.Items.Count To 1 Step -1
Set objItem = objFolder.Items.Item(i)
Select Case objFolder.DefaultItemType
‘Check email subject, body and sent time
Case olMailItem
strKey = objItem.Subject & “,” & objItem.Body & “,” & objItem.CreationTime
‘Check appointment subject, start time, duration, location and body
Case olAppointmentItem
strKey = objItem.Subject & “,” & objItem.Start & “,” & objItem.Duration & “,” & objItem.Location & “,” & objItem.Body
‘Check contact full name and email address
Case olContactItem
strKey = objItem.FullName & “,” & objItem.Email1Address & “,” & objItem.Email2Address & “,” & objItem.Email3Address
‘Check task subject, start date, due date and body
Case olTaskItem
strKey = objItem.Subject & “,” & objItem.StartDate & “,” & objItem.DueDate & “,” & objItem.Body
End Select
strKey = Replace(strKey, “, “, Chr(32))
‘Remove the duplicate items
If objDictionary.Exists(strKey) = True Then
objItem.Delete
Else
objDictionary.Add strKey, True
End If
Next i
End If
End Sub
I’m not very familiar with VBA or macros. I also get the “Run-time error ‘438’. Could anyone post a complete code with the code that worked.