asked on

Add Contact if does not exist, update if it does in Outlook using vbscript

I am trying to write code that will insert a contact in Outlook if it does not already exist, if it exist I want to update the contact.

The code below works for New Contacts, but does not work for updating existing contacts.

If i just use the Save it will add a duplicate contact.

Any Help would be appreciated.

Set objOutlook = CreateObject("Outlook.Application")
          Set myNameSpace = objOutlook.GetNameSpace("MAPI")
          Set myfolder = myNameSpace.GetDefaultFolder(10)
          sName = CONTACT_FIRST_NAME & " " & CONTACT_NAME
          Set myitem = myfolder.Items.Find("[FullName] = '" & sName & "'")
          If myItem is Nothing Then
             sAdd = "Yes"
          Else
             sAdd = "No"
          End If    
          With objOutlook
             Set conOutlookContact = .Application.CreateItem(2)
             conOutlookContact.FirstName = CONTACT_FIRST_NAME
             conOutlookContact.LastName = CONTACT_NAME
             conOutlookContact.PrimaryTelephoneNumber = CONTACT_PHONE
             conOutlookContact.BusinessFaxNumber = CONTACT_FAX
             conOutlookContact.BusinessAddress = rs("ADDR_1") & chr(13) & rs("ADDR_2") & chr(13) & rs("ADDR_3")
             conOutlookContact.BusinessAddressCity = rs("CITY")
             conOutlookContact.BusinessAddressState = rs("STATE")
             conOutlookContact.BusinessAddressPostalCode = rs("ZIPCODE")
             conOutlookContact.BusinessAddressCountry = rs("COUNTRY")
             conOutlookContact.BusinessAddressStreet = rs("ADDR_1") & chr(13) & rs("ADDR_2") & chr(13) & rs("ADDR_3")
             conOutlookContact.BusinessTelephoneNumber = CONTACT_PHONE
             conOutlookContact.CompanyName = rs("NAME")
             conOutlookContact.CustomerID = CUSTOMER_ID
             conOutlookContact.Email1Address = CONTACT_EMAIL
             conOutlookContact.JobTitle = CONTACT_POSITION
             If sAdd = "Yes" Then
                conOutlookContact.Save
             Else
                conOutlookContact.Update
             End If
         End With

Open in new window

Chris Bottomley

Try the following change:

Chris

          Set objOutlook = CreateObject("Outlook.Application")
          Set myNameSpace = objOutlook.GetNameSpace("MAPI")
          Set myfolder = myNameSpace.GetDefaultFolder(10)
          sName = CONTACT_FIRST_NAME & " " & CONTACT_NAME
          Set myitem = myfolder.Items.Find("[FullName] = '" & sName & "'")
          If myItem is Nothing Then
            Set conOutlookContact = objOutlook.CreateItem(2)
          Else
            Set conOutlookContact = myItem
          End If    
          With conOutlookContact
             conOutlookContact.FirstName = CONTACT_FIRST_NAME
             conOutlookContact.LastName = CONTACT_NAME
             conOutlookContact.PrimaryTelephoneNumber = CONTACT_PHONE
             conOutlookContact.BusinessFaxNumber = CONTACT_FAX
             conOutlookContact.BusinessAddress = rs("ADDR_1") & chr(13) & rs("ADDR_2") & chr(13) & rs("ADDR_3")
             conOutlookContact.BusinessAddressCity = rs("CITY")
             conOutlookContact.BusinessAddressState = rs("STATE")
             conOutlookContact.BusinessAddressPostalCode = rs("ZIPCODE")
             conOutlookContact.BusinessAddressCountry = rs("COUNTRY")
             conOutlookContact.BusinessAddressStreet = rs("ADDR_1") & chr(13) & rs("ADDR_2") & chr(13) & rs("ADDR_3")
             conOutlookContact.BusinessTelephoneNumber = CONTACT_PHONE
             conOutlookContact.CompanyName = rs("NAME")
             conOutlookContact.CustomerID = CUSTOMER_ID
             conOutlookContact.Email1Address = CONTACT_EMAIL
             conOutlookContact.JobTitle = CONTACT_POSITION
             conOutlookContact.Save
         End With

Open in new window

BFanguy

ASKER

Chris, thanks for the response.

Unfortunantly this still does not "Update" the contact, instead it Adds a New Contact even if it finds the existing Contact.

Chris Bottomley

In that case I expect your find statement is flawed ... i'll need to look at it in a little while.

Chris

BFanguy

ASKER

i added the following 2 message boxes:

If myItem is Nothing Then
msgbox("new contact")
Set conOutlookContact = objOutlook.CreateItem(2)
Else
msgbox("existing contact")
Set conOutlookContact = myItem

I am getting the message "Existing Contact" if they already exist - so i don't think the find is flawed.

Chris Bottomley

Are you running this as part of a loop?

Chris

Chris Bottomley

Nah, if it were that then the error would be the other way around but that said use the following change ... and it'll do no harm anyway.

Nice bit of test code though, however I am now confused and then some, the code sets conOutlookContact yet you are saying it writes a new record. I guess i've made an error so let me look deeper for a few minutes

Chris

Set objOutlook = CreateObject("Outlook.Application")
          Set myNameSpace = objOutlook.GetNameSpace("MAPI")
          Set myfolder = myNameSpace.GetDefaultFolder(10)
          sName = CONTACT_FIRST_NAME & " " & CONTACT_NAME
          Set myItem = nothing
          Set myitem = myfolder.Items.Find("[FullName] = '" & sName & "'")
          If myItem is Nothing Then
            Set conOutlookContact = objOutlook.CreateItem(2)
          Else
            Set conOutlookContact = myItem
          End If    
          With conOutlookContact
             conOutlookContact.FirstName = CONTACT_FIRST_NAME
             conOutlookContact.LastName = CONTACT_NAME
             conOutlookContact.PrimaryTelephoneNumber = CONTACT_PHONE
             conOutlookContact.BusinessFaxNumber = CONTACT_FAX
             conOutlookContact.BusinessAddress = rs("ADDR_1") & chr(13) & rs("ADDR_2") & chr(13) & rs("ADDR_3")
             conOutlookContact.BusinessAddressCity = rs("CITY")
             conOutlookContact.BusinessAddressState = rs("STATE")
             conOutlookContact.BusinessAddressPostalCode = rs("ZIPCODE")
             conOutlookContact.BusinessAddressCountry = rs("COUNTRY")
             conOutlookContact.BusinessAddressStreet = rs("ADDR_1") & chr(13) & rs("ADDR_2") & chr(13) & rs("ADDR_3")
             conOutlookContact.BusinessTelephoneNumber = CONTACT_PHONE
             conOutlookContact.CompanyName = rs("NAME")
             conOutlookContact.CustomerID = CUSTOMER_ID
             conOutlookContact.Email1Address = CONTACT_EMAIL
             conOutlookContact.JobTitle = CONTACT_POSITION
             conOutlookContact.Save
         End With

Open in new window

ASKER CERTIFIED SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

BFanguy

ASKER

Chris,

don't know what I did different from this morning, but I copied your code from above and you are correct, it is updating not duplicating anymore.

appreciate all of your help!

Chris Bottomley

Glad about that, I was struggling to think how it was failing.

Chris