Update Outlook Contact Item using VBA

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I use the following code to create an outlook contact item:

Dim olApp As Outlook.Application
Dim olNewContact As Outlook.ContactItem

Set olApp = CreateObject("Outlook.Application")
Set olNewContact = olApp.CreateItem(olContactItem)

With olNewContact

... set data fields ...

.Save

End With

Does anyone know how can I use VBA to UPDATE a contact item once it's been created? Thanks.
 
You'd use

... set data fields ...
MyContact.Save

The potentially hard part is getting MyContact in the first place. You
didn't say *which* contact you wanted to update.
 
Sue,

You're right, I didn't say, because I don't know what identifies a contact, what the "key" is, and how to get currency on the item I want to update. That is the part I don't know. If I had some clue as to where it was documented I wouldn't have to ask.

--
Michael Ryle
North Eastham, MA


Sue Mosher said:
You'd use

... set data fields ...
MyContact.Save

The potentially hard part is getting MyContact in the first place. You
didn't say *which* contact you wanted to update.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
Click to expand...
 
Again, there's not enough context to your question to provide a direct
answer. Do you want the contact named "Michael Ryle"? What if there are two?
Each Outlook item has a unique EntryID property, but it's a long string
you're not likely to memorize. Perhaps you should explain just what
application you have in mind.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Michael Ryle said:
Sue,

You're right, I didn't say, because I don't know what identifies a
Click to expand...
contact, what the "key" is, and how to get currency on the item I want to
update. That is the part I don't know. If I had some clue as to where it
was documented I wouldn't have to ask.
 
On Monday, I enter personal information (name, phone, email, etc.) for a new client in an Access form.

When the Access form is closed, VBA code copies (i.e. propagates) this information into Outlook by creating a new contact item as described below.

On Wednesday, the client tells me he has a new email address and I change it in Access. How do I update the corresponding contact item?

This presumes there are no duplicates in the Outlook contacts folder (or there aren't supposed to be).
 
After you initially create the Outlook contact item and save it, get its
EntryID property and store it in your database. When you need to do an
update, you can call Namespace.GetItemFromID to retrieve the contact from
the EntryID.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Michael Ryle said:
On Monday, I enter personal information (name, phone, email, etc.) for a new client in an Access form.

When the Access form is closed, VBA code copies (i.e. propagates) this
Click to expand...
information into Outlook by creating a new contact item as described below.
On Wednesday, the client tells me he has a new email address and I change
Click to expand...
it in Access. How do I update the corresponding contact item?
This presumes there are no duplicates in the Outlook contacts folder (or
Click to expand...
there aren't supposed to be).
 
Hi,

I found some VBA code on another forum and adapted it so that I could update my phone numbers with international dialling codes if they didn't already have them. Here's the code:

It would be a good idea to BACK UP contacts before using this!

Sub correct_phone_nos_country_code()
Dim olApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objItem As Object, objAdd As Object
Dim new_no As String

'Loop through all the contacts in the contacts folder, and see if we
' have a match with the LastName and FirstName in the current line,
' and if so, update that contact's data
' TODO: Find out if there's some way to find a matching LastName and FirstName
' in Outlook VBA without having to loop through everything, like maybe an
' equivalent for the FindFirst method in Access VBA?

Set olApp = CreateObject("Outlook.Application")
Set myNameSpace = olApp.GetNamespace("MAPI")

Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts) ' <-- Main (default) contacts folder
' objFolder.ShowAsOutlookAB = True ' ticks box to see folder content items as contacts
Set objItems = objFolder.Items

For Each objItem In objItems
' Make sure we have a contact item
With objItem
If .Class = olContact Then

Debug.Print .FileAs, .BusinessTelephoneNumber, .HomeTelephoneNumber, .MobileTelephoneNumber
.HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber)
.BusinessTelephoneNumber = correct_phone_no_to_international(.BusinessTelephoneNumber)
.HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber)
.MobileTelephoneNumber = correct_phone_no_to_international(.MobileTelephoneNumber)
.BusinessFaxNumber = correct_phone_no_to_international(.BusinessFaxNumber)
'objItem.BusinessTelephoneNumber = strBusPhone$
'objItem.MobileTelephoneNumber = strMobilePhone$
'objItem.Email1Address = strEmail1$
objItem.Save
End If
End With
Next

End Sub
Function correct_phone_no_to_international(phone_no As String) As String
Dim new_phone_no As String
Dim my_country_code As String


'****change this to your country code:
my_country_code = "+44"
'***********

If Len(Trim(phone_no)) = 0 Then
change_phone_no_to_international = ""
Exit Function
End If

If Left$(phone_no, 1) <> "+" Then
new_phone_no = my_country_code + Mid$(phone_no, 2)
correct_phone_no_to_international = new_phone_no
End If

End Function
 
Last edited:
I cannot edit my original post (seemingly)

There is a bug in the original code - use this:

Sub correct_phone_nos_country_code()
Dim olApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objItem As Object, objAdd As Object
Dim new_no As String

'Loop through all the contacts in the contacts folder, and see if we
' have a match with the LastName and FirstName in the current line,
' and if so, update that contact's data
' TODO: Find out if there's some way to find a matching LastName and FirstName
' in Outlook VBA without having to loop through everything, like maybe an
' equivalent for the FindFirst method in Access VBA?

Set olApp = CreateObject("Outlook.Application")
Set myNameSpace = olApp.GetNamespace("MAPI")

Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts) ' <-- Main (default) contacts folder
' objFolder.ShowAsOutlookAB = True ' ticks box to see folder content items as contacts
Set objItems = objFolder.Items

For Each objItem In objItems
' Make sure we have a contact item
With objItem
If .Class = olContact Then

Debug.Print .FileAs, .BusinessTelephoneNumber, .HomeTelephoneNumber, .MobileTelephoneNumber
.HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber)
.BusinessTelephoneNumber = correct_phone_no_to_international(.BusinessTelephoneNumber)
.HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber)
.MobileTelephoneNumber = correct_phone_no_to_international(.MobileTelephoneNumber)
.BusinessFaxNumber = correct_phone_no_to_international(.BusinessFaxNumber)
'objItem.BusinessTelephoneNumber = strBusPhone$
'objItem.MobileTelephoneNumber = strMobilePhone$
'objItem.Email1Address = strEmail1$
objItem.Save
End If
End With
Next

End Sub
'=============================================
Function correct_phone_no_to_international(phone_no As String) As String
Dim new_phone_no As String
Dim my_country_code As String


'****change this to your country code:
my_country_code = "+44"
'***********
correct_phone_no_to_international = phone_no
If Len(Trim(phone_no)) = 0 Then
change_phone_no_to_international = ""
Exit Function
End If

If Left$(phone_no, 1) <> "+" Then
new_phone_no = my_country_code + Mid$(phone_no, 2)
correct_phone_no_to_international = new_phone_no
End If
End Function
 
Back
Top