Solved

Update Outlook Contact from Access

Posted on 2009-05-06
4
360 Views
Last Modified: 2013-11-27
Dear Experts

I have a piece of code for my Access 2003 database that looks up a contact in Outlook 2003 and if they dont exist (the criteria being where "[Profession] = 'OverpaidDirector'") then it adds a new contact.  At present if the contact exists it returns a message box stating XXXXXXXXXXXXXXX  What I would like to do is for the code to take the contact its found and then update various fields (i.e. CompanyName = "Success")

Can anyone supply a piece of code / adapt this one to do that

Many thanks

The code I have is this

Private Sub Command256_Click()
    Dim objApp As Object
    Dim objNamespace As Object
    Dim oF As Object
    Dim objContacts As Object
    Const olFolderContacts = 10
    Const olContactItem = 2
   
    Set objApp = CreateObject("Outlook.Application")
    Set objNamespace = objApp.GetNamespace("MAPI")
    Set oF = objNamespace.GetDefaultFolder(olFolderContacts)
   
    Set objContacts = oF.items.Find("[Profession] = 'OverpaidDirector'")
    If Not TypeName(objContacts) = "Nothing" Then
    MsgBox " XXXXXXXXXXXXXXX "
    Else
        'Create new item if not found
        Set objContacts = objApp.CreateItem(olContactItem)
    End If
        objContacts.Profession = "OverpaidDirector"
        objContacts.FirstName = "BBB"
        objContacts.LastName = "AAAA"
        objContacts.Email1Address = "Email@Addr.com"
        objContacts.Title = "Mr"
        objContacts.CompanyName = "Company"
        objContacts.BusinessTelephoneNumber = "OfficePhone"
        objContacts.MobileTelephoneNumber = "MobilePhone"
        objContacts.BusinessAddressCity = "BusCity"
        objContacts.BusinessAddressCountry = "BusCountry"
        objContacts.BusinessAddressPostalCode = "Zip Code"
        objContacts.BusinessAddressState = "CA"
        objContacts.BusinessAddressStreet = "BusStreet"
        objContacts.BusinessTelephoneNumber = "BusTelNumber"
        objContacts.HomeAddressCity = "HomeCity"
        objContacts.HomeAddressCountry = "HomeCountry"
        objContacts.HomeAddressPostalCode = "Zip Code 2"
        objContacts.HomeAddressState = "AC"
        objContacts.HomeAddressStreet = "HomeStreet"
        objContacts.HomeTelephoneNumber = "HomeTelNumber"
        objContacts.Save
   
    Set objContacts = Nothing
    Set objNamespace = Nothing
    Set objApp = Nothing
End Sub
0
Comment
Question by:correlate
  • 2
4 Comments
 
LVL 17

Expert Comment

by:Shanmuga Sundaram
Comment Utility
0
 

Author Comment

by:correlate
Comment Utility
Thanks for that, it looks like its using a very different method to mine & I was keen to build on this piece of code as I'm a bit more familiar with it & didn't really understand the workings of what they were trying to do in the links (i'm not strong technically)
0
 
LVL 65

Accepted Solution

by:
rockiroads earned 500 total points
Comment Utility
Hi mate, sorry I didnt get round to this earlier.

When u do the find, it returns you the contact object. So objContacts is populated. We have to create objContacts if it doesnt exist

We can then use a flag to identify if its a new or update operation, this is handy where you want certain fields set on a add only


Private Sub Command256_Click()
   
    Dim objApp As Object
    Dim objNamespace As Object
    Dim oF As Object
    Dim objContacts As Object
    Const olFolderContacts = 10
    Const olContactItem = 2
    Dim bNewItem As Boolean
   
    Set objApp = CreateObject("Outlook.Application")
    Set objNamespace = objApp.GetNamespace("MAPI")
    Set oF = objNamespace.GetDefaultFolder(olFolderContacts)
   
    'RETURN THE ContactsObject
    Set objContacts = oF.items.Find("[Profession] = 'OverpaidDirector'")
       
    'Assume record found
    bNewItem = False
   
    'Create new ContactsObject if not found by above
    If TypeName(objContacts) = "Nothing" Then
        Set objContacts = objApp.CreateItem(olContactItem)
        'Flag to indicate new item
        bNewItem = True
    End If
   
    'SET FIELDS
   
    'TO ENSURE YOU SET FIELDS ON ADD ONLY, USE FLAG
    If bNewItem = True Then
        'Following get set on Add only
        objContacts.Profession = "OverpaidDirector"
    End If
   
    'Following get set on add and update
    objContacts.FirstName = "BBB"
    objContacts.LastName = "AAAA"
    objContacts.Email1Address = "Email@Addr.com"
    objContacts.Title = "Mr"
    objContacts.CompanyName = "Company"
    objContacts.BusinessTelephoneNumber = "OfficePhone"
    objContacts.MobileTelephoneNumber = "MobilePhone"
    objContacts.BusinessAddressCity = "BusCity"
    objContacts.BusinessAddressCountry = "BusCountry"
    objContacts.BusinessAddressPostalCode = "Zip Code"
    objContacts.BusinessAddressState = "CA"
    objContacts.BusinessAddressStreet = "BusStreet"
    objContacts.BusinessTelephoneNumber = "BusTelNumber"
    objContacts.HomeAddressCity = "HomeCity"
    objContacts.HomeAddressCountry = "HomeCountry"
    objContacts.HomeAddressPostalCode = "Zip Code 2"
    objContacts.HomeAddressState = "AC"
    objContacts.HomeAddressStreet = "HomeStreet"
    objContacts.HomeTelephoneNumber = "HomeTelNumber"
   
    'SAVE Contact
    objContacts.Save
   
    Set objContacts = Nothing
    Set objNamespace = Nothing
    Set objApp = Nothing
End Sub

0
 

Author Closing Comment

by:correlate
Comment Utility
Absolute Star - It works perfectly thank you very much
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Outlook Free & Paid Tools
Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now