|
|
|
Question : Outlook 2003. Update Outlook.ContactItem via VBA code.
|
|
I am trying to update an outlook Outlook.ContactItem via code. The code below allows me to query the contact items that match a criteria.
I am using Outlook 2003. I just do not see how to update a contact item. Can this be done? If you have a reference or a code sample that would be great.
The purpose of the excercise it to allow the user to udpate the address book based on select criteria. Want to update from an application as updating in Outlook is cumersome to do with over 1500 contacts.
Thanks
'--------------------------------------------------------------------------------------------
Private Function CreateEmailList(str_Email_Group As String)
Dim myOlApp As Outlook.Application
Dim myNameSpace
Dim myFolder
Dim myNewFolder
Dim oItem As Outlook.ContactItem
Dim oFSO As New Scripting.FileSystemObject
Dim oStream As Scripting.TextStream
Dim lng_Count As Long
Dim bln_Skip As Boolean
Dim SafeItem As Redemption.SafeMailItem
Dim int_loop As Integer
Dim int_loop2 As Integer
Dim bln_Print As Boolean
Dim varCategories As Variant
lng_Count = -1
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set myNewFolder = myFolder.Folders("XDI Address Book")
On Error Resume Next
For int_loop = 1 To myNewFolder.Items.Count - 1
On Error Resume Next
Set oItem = myNewFolder.Items(int_loop)
If Err.Number > 0 Then
bln_Skip = True
Else
bln_Skip = False
End If
On Error GoTo 0
If bln_Skip = False Then
If Not (oItem Is Nothing) Then
If Trim$(oItem.Email1Address) <> vbNullString Then
Debug.Print oItem.CompanyName
bln_Print = False
varCategories = Split(oItem.Categories, ",")
For int_loop2 = 0 To UBound(varCategories)
If Trim$(UCase$(varCategories(int_loop2))) = Trim$(UCase$(str_Email_Group)) Then
bln_Print = True
Exit For
End If
Next
If bln_Print = True Then
lng_Count = lng_Count + 1
Range("Email_List_Anchor").Offset(lng_Count, 1) = oItem.CompanyName
Range("Email_List_Anchor").Offset(lng_Count, 2) = oItem.FullName
Range("Email_List_Anchor").Offset(lng_Count, 3) = oItem.Email1Address
End If
End If
End If
If lng_Count = 244 Then
Debug.Print lng_Count
End If
End If
Next
MsgBox "Complete. A total of " & lng_Count + 1 & " email addresses have been retreived from the Address Book"
End Function
|
Answer : Outlook 2003. Update Outlook.ContactItem via VBA code.
|
|
Hi andyringle,
You update a contact item, or indeed any Outlook item, by setting the contact's properties with the values read in from the outside source and then issuing the Save command to commit the changes to Outlook. Something like this script that I created for another question.
Sub UpdateFromExcel()
Dim olkContacts As Outlook.MAPIFolder, _
olkContact As Outlook.ContactItem, _
excApp As Excel.Application, _
excBook As Excel.Workbook, _
excSheet As Excel.Worksheet, _
intRow As Integer
Set excApp = CreateObject("Excel.Application")
Set excBook = excApp.Workbooks.Open("C:\myContacts.xls")
Set excSheet = excBook.Sheets.Item(1)
Set olkContacts = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
intRow = 2
Do While excSheet.Cells(intRow, 2) <> ""
Set olkContact = olkContacts.Items.Find("[LastName] = '" & excSheet.Cells(intRow, 2) & "' And [FirstName] = '" & excSheet.Cells(intRow, 3) & "'")
If Not IsNothing(olkContact) Then
olkContact.CompanyName = excSheet.Cells(intRow, 1)
olkContact.BusinessTelephoneNumber = excSheet.Cells(intRow, 4)
olkContact.Business2TelephoneNumber = excSheet.Cells(intRow, 5)
olkContact.Save
Set olkContact = Nothing
End If
intRow = intRow + 1
Loop
Set olkContact = Nothing
Set olkContacts = Nothing
excBook.Close
Set excSheet = Nothing
Set excBook = Nothing
Set excApp = Nothing
MsgBox "All Done!"
End Sub
Cheers!
|
|
|
|
|
|
|
