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

BFanguyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Chris BottomleySoftware Quality Lead EngineerCommented:
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

0
BFanguyAuthor Commented:
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.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
In that case I expect your find statement is flawed ... i'll need to look at it in a little while.

Chris
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

BFanguyAuthor Commented:
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.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Are you running this as part of a loop?

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
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

0
Chris BottomleySoftware Quality Lead EngineerCommented:
I have just re-run the code and it works fine, saving new and opening old.  Does it fail for every contact or only some ... and where it creates a duplicate contact, does it create a third copy or only ever 1 extra copy?  I'm thinking here the file save as name being the wrong way around to the default.

Chris
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
BFanguyAuthor Commented:
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!
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Glad about that, I was struggling to think how it was failing.

Chris
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.