best duplicate contact remover?

[mr_malkovich]

Hey all. I have Outlook 2013/Office 365 on Windows 7. I need a good application to delete contact files with containing duplicate email addresses across multiple Outlook contact folders. The only criteria I have for deleting a contact is if the email in Email Field 1 is the same. Not duplicate names or companies or anything else. I want the newer contact file to be deleted. I'd like it to be a one-touch process, ie: if 300 duplicate contacts are found, I want to be able to delete them with one touch. I was using Contact Scrubber but it doesn't work with 64-bit Outlook installations, and you have to delete each duplicate contact one by one.

Is there an app for this? Or should I look around for someone to write me something custom?

Thanks much.

 

[Diane Poremsky]

I'm not sure of any of the duplicate removers are that specific - I know mapilab's can check the fields you specify. But... if email address is the only criteria and you want to always keep the newest, VBA should work fine, although it might be slower than a compiled app. Basically, search for the email address and if matches are found, delete the ones with older created date.

 

[mr_malkovich]

For instance, I have several hundred contacts in one Outlook contact sub-folder and a couple thousand in another. I need some kind of application or script that will find any contact folders across those folders containing duplicate email addresses, and delete the newer of the two.

 

[Diane Poremsky]

Do you need multiple folders? If not, it will be easier - you can drag everything to the main folder and if check for duplicates is enabled, you can merge the dupes.

This will delete the duplicates with matching emails. It doesn't check for creationtime, i tried to add an if statement to compare times but it only deletes 1 match when i use it. I'm obviously not doing something right - probably because this macro deletes the current contact, where I'm trying to compare it to the next one.

It also only works on the default contacts folder - its easy to make it work on any folder, but harder to make it check multiple folders.

Sub DeleteDuplicateContacts() 
  Dim contactItems As Outlook.Items 
  Dim contact As Outlook.ContactItem 
  Dim contactEmail As String 
  Dim filteredContacts As Outlook.Items 
  Dim countContacts As Long 
  Dim i As Long 
  Set contactItems = Session.GetDefaultFolder(olFolderContacts).Items 
  countContacts = contactItems.Count 
  For i = countContacts To 1 Step -1 
  
   If TypeName(contactItems.Item(i)) = "ContactItem" Then 
      Set contact = contactItems.Item(i) 
      contactEmail = contact.Email1Address 
If contactEmail = "" Then GoTo nexti 
      Set filteredContacts = _ 
    contactItems.Restrict("[Email1Address] = '" & contactEmail & "'") 
      If Not filteredContacts.Count = 1 Then ' possible dupe 
          contact.Delete 
      End If 
    End If 
nexti: 
  Next i 
End Sub

 

[Diane Poremsky]

Ah, figured it out, i think. This code checks the created time and deletes the newer contact.

Sub DeleteDuplicateContacts() 
  Dim contactItems As Outlook.Items 
  Dim contact As Outlook.ContactItem 
  Dim contactEmail As String 
  Dim filteredContacts As Outlook.Items 
  Dim countContacts As Long 
  Dim i As Long 
  Dim d As Long 
  Set contactItems = Session.GetDefaultFolder(olFolderContacts).Items 
  countContacts = contactItems.Count 
  For i = countContacts To 1 Step -1 
  
   If TypeName(contactItems.Item(i)) = "ContactItem" Then 
      Set contact = contactItems.Item(i) 
      contactEmail = contact.Email1Address 
Debug.Print contactEmail 
If contactEmail = "" Then GoTo nexti 
      Set filteredContacts = _ 
    contactItems.Restrict("[Email1Address] = '" & contactEmail & "'") 
      If Not filteredContacts.Count = 1 Then ' possible dupe 
       For d = filteredContacts.Count To 1 Step -1 
       Debug.Print d 
       On Error Resume Next 
      If contact.CreationTime > filteredContacts.Item(d).CreationTime Then 
          contact.Delete 
          Else 
          filteredContacts.Item(d).Delete 
        
     End If 
    
      Next d 
    End If 
  End If 
nexti: 
  Next i 
End Sub

 

[mr_malkovich]

Hmmm, yeah the application that will work for me is probably going to have to work across multiple folders. I still want to try this code though. How do I actually run it? Forgive me, I know I should know this. Also, my contact files are a custom form I've created - 112607.fdm. Will that affect the code?

Thank you so much. This week has been one obstacle after another since installing O365 but I know (hope?) it's for the best in the long term.

 

[Diane Poremsky]

It *should* work with the custom form since it looks at the item type, not the form name, but if you only have contacts - no contact groups (DLs) - you can remove this line and the corresponding End if - the only purpose it serves is to avoid errors when there are contact groups.
If TypeName(contactItems.Item(i)) = "ContactItem" Then

To use it, paste it into the VB Editor and click Run.
http://www.slipstick.com/developer/how-to-use-outlooks-vba-editor/

The debug.print lines were used for error checking, they can be deleted.

When I get a chance I'll work on making it work across multiple folders.