'MsgBox totalCount & " Items to Process."ĭebug.Print olFolder & " : Found multiple emails recieved at " & lastReceived & ", checking for duplicates." Attribute VB_Name = "DelDupEmails_DATE_SUBJECT" I did a different format for the debug.print messages.
I added an error exception for an error I got some times on the function: Set olDuplicatesFolder = olFolder.Folders("Duplicates"). My simplification is to match ONLY the receive TIME STAMP and the SUBJECT. I don't know why, as I am sure those mail are true duplicates.
#Outlook duplicate remover how to use full
I simplified the duplicate search as in my case I imported multiple duplicates from PST files but the full mail body didn't match. GetMailKey = objMail.Subject & objMail.Body GetMailKey = objMail.Subject & objMail.HTMLBody Also works for calendar invites, etc.: Function GetMailKey(ByRef objMail As Object) As String Adapt as needed, but I think if the subject and full body are the same, there's no point in checking anything else. ' Keep track of this mail in case we end up needing to build a dictionaryĭebug.Print "Finished moving Duplicate Emails"Īnd the helper function referenced above for "uniquely identifying" an email. ' This can't be a duplicate, it has a different date, reset our dictionary ' No need to track the last mail, since we have it in the dictionary ' Now check the current mail item to see if it's a duplicateĭebug.Print "Found Duplicate: """ & objMail.Subject & " on " & lastReceived ' Add the last mail to the dictionary if it hasn't been tracked yetĭebug.Print "Found multiple emais recieved at " & lastReceived & ", checking for duplicates." ' Might be a duplicate track mail contents until this recieved time changes. If olDuplicatesFolder Is Nothing Then Set olDuplicatesFolder = ("Duplicates")ĭebug.Print "Sorting " & olFolder.Name & " by ReceivedTime."ĭebug.Print totalCount & " Items to Process."ĭebug.Print "Error: Expected emails to be in order of date recieved. Set olDuplicatesFolder = olFolder.Folders("Duplicates") Sub DeleteDuplicateEmails()ĭim objMail As Object, objDic As Object, objLastMail As Objectĭim olFolder As Folder, olDuplicatesFolder As Folderĭim received As Date, lastReceived As Date This script also takes into account the fact that some items use an HTMLBody for the full message definition, and others don't have that property. Once the date changes, you know you'll never see another email with the prior date, therefore, they won't be duplicates, so you can clear your dictionary on each date change. There's no need to maintain a giant dictionary of every email you've seen if you are processing emails in a deterministic order (e.g. Here's a script that takes advantage of sorting emails to check for duplicates much more efficiently. MsgBox "duplicate items were removed to ""removed items""", vbCritical, "See " & strPath & " for details" ObjTF.WriteLine Replace(objItem.Subject, ", ", Chr(32)) StrCheck = Replace(strCheck, ", ", Chr(32)) StrCheck = objItem.Subject & "," & objItem.Body & "," If olFolder2 Is Nothing Then Set olFolder2 = ("removed items")įor lngCnt = To 1 Step -1 Set olFolder2 = olFolder.Folders("removed items") Set objTF = objFSO.CreateTextFile(strPath) Set objFSO = CreateObject("scripting.filesystemobject") Set objDic = CreateObject("scripting.dictionary") Tested on Outlook 2016 Const strPath = "c:\temp\deleted msg.csv" I have changed the test to subject and body Updated: Checking for size surprisingly missed a number of dupes, even for otherwise identical mail items. Create a CSV file - stored under the path in StrPath to create a external reference to Outlook of the emails that have been moved.Moved (rather than delete) any duplicates into a sub-folder ( removed items) of the folder being processed.Checks duplicates on the base of Subject, Sender, CreationTime and Size.Provides users with a prompt to select the folder to process.