We help IT Professionals succeed at work.
Get Started

Outlook 2003.  Update Outlook.ContactItem  via  VBA code.

andyringle
andyringle asked
on
1,127 Views
Last Modified: 2011-08-18
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
Comment
Watch Question
CERTIFIED EXPERT
Top Expert 2010
Commented:
This problem has been solved!
Unlock 1 Answer and 5 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE