Outlook email - Remove duplicate contacts from excel import

  • Hey guys, I'm using a macro I found on the internet to import contacts from excel to outlook. I tailored it to suit my sheet and needs and it's working well. The only thing is, if a contact is already in outlook it still creates a new contact with the same details (therefore making it a duplicate). Is there a code to ensure that excel does not import duplicate contacts using VBA?


    Here is the code



    Kind Regards,


    Julian

  • Re: Outlook email - Remove duplicate contacts from excel import


    Hi Pike, I'm not that great with VBA, what do you mean by adding code tags to the VBA syntax?

  • Re: Outlook email - Remove duplicate contacts from excel import


    Can you work this in to your code to check if the contact exists

    Code
    Set objItem = objItems.Find("[FileAs]=" & Chr(34) & strLastName$ & ", " & strFirstName$ & Chr(34))
    If Not TypeName(objItem) = "Nothing" Then
      ' Match found
      ...
    End If
  • Re: Outlook email - Remove duplicate contacts from excel import


    I'm getting a Run Time 424 Object Required Error - Not sure if I'm using it right, but definitely on the right track as to how I wanted to handle this!

  • Re: Outlook email - Remove duplicate contacts from excel import


    The items collection of a MAPIFolder has a Find method:

    Code
    Set olApp = CreateObject("Outlook.Application")
     Set myNameSpace = olApp.GetNamespace("MAPI")
    
    
     Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
    
    
    Set objItems = objFolder.Items


    http://www.outlookcode.com/thr…forumid=2&messageid=19878

  • Re: Outlook email - Remove duplicate contacts from excel import


    Hmm still can't manage to get it to work. It doesn't seem to find it or anything. Maybe I'm not copying or pasting it into the right order or something?

  • Re: Outlook email - Remove duplicate contacts from excel import


    Hmm... very hard to evaluate without the code you using
    but try

    Code
    Set objItem = objItems.Find("[FileAs]=" & Chr(34) & ActiveSheet.Cells(i, 6) & ", " & ActiveSheet.Cells(i, 5) 
     & Chr(34)) 
    If Not TypeName(objItem) = "Nothing" Then 
         ' Match found
        ... 
    End If

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!