How to merge two folders without duplicates into one folder in Outlook?
In Outlook, you may have many email accounts with many folders, in some cases, you want to merge two folders into one and remove the duplicate items. How can you quickly solve this job? In this article, I introduce a VBA code to help you handle it as quickly as possible in Outlook.
To merge two folders into one and remove the duplicate items, you can handle it with VBA code as following steps:
1. Press Alt + F11 keys to enable the Microsoft Visual Basic for Applications window
2. Double click at ThisOutlookSession from Project1 in left pane, then copy and paste below code to the right script.
VBA: Merge two folders without diplicates
Sub MergeOutlookFolders_WithoutDuplicates() 'UpdatebyExtendoffice20180521 Dim xSourceFolder As Outlook.Folder Dim xTargetFolder As Outlook.Folder Dim xCount, i As Long Dim xItem As Object Dim xSourceItem As Object Dim xTargetItem As Object Dim xDictionary As Scripting.Dictionary 'Object Dim xStr As String On Error Resume Next Set xDictionary = New Scripting.Dictionary Set xSourceFolder = Application.Session.PickFolder Set xTargetFolder = Application.Session.PickFolder xCount = 0 If xSourceFolder.DefaultItemType <> xTargetFolder.DefaultItemType Then MsgBox "Error: The two folders are not in same type!", vbExclamation + vbOKOnly, "Kutools for Outlook" Exit Sub End If For i = xSourceFolder.Items.Count To 1 Step -1 Set xSourceItem = xSourceFolder.Items.Item(i) xSourceItem.Move xTargetFolder Next For i = xTargetFolder.Items.Count To 1 Step -1 Set xTargetItem = xTargetFolder.Items.Item(i) Select Case xTargetItem.Class Case olMail With xTargetItem xStr = .Subject & .Body & .SentOn End With Case olAppointment With xTargetItem xStr = .Subject & .Start & .Duration & .Location & .Body End With Case olContact With xTargetItem xStr = .FullName & .Email1Address & .Email2Address & .Email3Address End With Case olTask With xTargetItem xStr = .Subject & .StartDate & .DueDate & .Body End With End Select If xDictionary.Exists(xStr) = True Then xTargetItem.Delete xCount = xCount + 1 Else xDictionary.Add xStr, True End If Next i If xCount <> 0 Then MsgBox xCount & " duplicates removed when merging!", vbInformation + vbOKOnly, "Kutools for Outlook" End If End Sub
3. Click Tools > References and in the popping dialog, check Microsoft Scripting Runtime checkbox.
4. Click OK. Now press F5 key to run the code. A dialog pops out to remind you select the first folder you want to merge (note: all the items in the first folder will be removed after merging with the second folder).
5. Click OK, in the second popping dialog, choose the second folder you want to compare and merge with.
6. Click OK, now, all the items in the first folder will be moved to the second folder, and the duplicate ones are also removed.
If you are not familiar with VBA code, try to use Kutools for Outlook, a handy add-in, with its Consolidating Folders and Duplicate Emails utilities which can easily and quickly handle this job.
|Kutools for Outlook , Includes 100+ powerful features and tools for Microsoft Outlook 2016, 2013, 2010 and Office 365.
Free install Kutools for Outlook, and then do as below steps:
Merge multiple folders
1. Click Kutools Plus > Consolidating Folders, then in the Merge multiple folders into one dialog, click Add to add the folders into list which will be merged, choose a folder as the destination folder.
2. Click OK > OK. Now all the items in the selected folders have been merged into one specific folder.
Remove duplicate items
4. Click Next, in Duplicate Messages Settings dialog, specify the criteria you use to compare emails, then check Delete duplicate messages option and select Compare for duplicate messages within a single folder.
Best Office Productivity Tools
Kutools for Outlook - Over 100 Powerful Features to Supercharge Your Outlook
📧 Email Automation: Out of Office (Available for POP and IMAP) / Schedule Send Emails / Auto CC/BCC by Rules When Sending Email / Auto Forward (Advanced Rules) / Auto Add Greeting / Automatically Split Multi-Recipient Emails into Individual Messages ...
Over 100 Features Await Your Exploration! Click Here to Discover More.