How to Quickly Remove the Duplicate Outlook Items in a Folder via VBA

If you wish to remove the duplicate items in Outlook, searching and removing one by one will be quite troublesome. This post will teach you how to quickly complete it with Outlook VBA.

In my previous article – “How to Quickly Find and Remove Duplicate Emails in Outlook”, you can learn a trick to find and remove duplicate emails, which firstly sort the emails by subject, then by received time and then by attachments to find out the duplicate items and lastly select the duplicate ones and press “Delete” key. Although this method is seemingly a bit more convenient, but it is far more troublesome compared with using Outlook VBA. By the following VBA codes, you can quickly remove the duplicate items simply via one click, no matter emails, tasks, contacts or appointments. Now read on to get the codes in detail.

Remove the Duplicate Outlook Items in a Folder

1. To start with, launch your Outlook program.
2. Then press “Alt + F11” key buttons.
3. In the subsequent VBA editor window, double click to open a module which is in use or directly insert a new module by “Insert” > “Module”.
4. Next copy and paste the following VBA codes into the module.

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

5. After that, digitally sign this macro and change your Outlook macro security level to low.
6. Later, you can run this new VBA project. Directly click on the “Run” icon in the toolbar.
7. Subsequently, you’ll be required to select a folder where you want to remove duplicate items.
8. Finally, the duplicate items in the selected folder will be deleted at once.

Safeguard Vulnerable PST Data

Due to the fact that PST file is susceptible to corruption, thus you should spend a lot of efforts to safeguard your PST file. For instance, you should prevent Outlook from being closed improperly. Furthermore, you need prepare a robust Outlook fix tool, such as DataNumen Outlook Repair that will be able to salvage your PST in time.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including recover SQL Server and outlook repair software products. For more information visit www.datanumen.com