Project Description
VBA Subroutine to set Outlook 2007 Contact property (Categories) programmatically

Attached VBA code could set Outlook Contact Categories programmatically. For example, let's assume that there is a Contacts Folder named "LinkedIn" and all contact items in this folder should have the "LinkedIn" string added to their Category list. Add this module to Outlook 2007 and run the macro (ALT+F8, then select "SetCategory") to do the job.
Customization: set the following strings pertinent to your task:
' specify contact folder
Const strContactFolder As String = "LinkedIn"

' specify category to add to each contact item in the folder
Const strCategory As String = "LinkedIn"

Option Explicit

'USAGE  : SPECIFY THE CONTACT FOLDER AND
'       : THE CATEGORY STRING TO BE ADDED TO ALL CONTACT ITEMS
'*************************************************************
Sub SetCategory()
    
    ' specify contact folder
    Const strContactFolder As String = "LinkedIn"
    
    ' specify category to add to each contact item in the folder
    Const strCategory As String = "LinkedIn"
    
    ' outlook App object
    Dim objOutlook As Outlook.Application
    
    ' contact folder object
    Dim objContactFolder As Outlook.Folder
    
    ' contact item object
    Dim objContactItem As Outlook.ContactItem
    
' error handler
On Error GoTo ErrorHandle:
    
    'set outlook application object
    Set objOutlook = New Outlook.Application
    
    With objOutlook.GetNamespace("MAPI")
    
        ' confirm the operation or cancel
        If MsgBox("Procedure will add the Category [" & strCategory & "] to the folder [" & _
        strContactFolder & "]. Do you want to proceed?", vbYesNo) <> vbYes Then GoTo Exiting:
        
        'set contact folder object
        With .GetDefaultFolder(olFolderContacts)
            Set objContactFolder = .Folders.Item(strContactFolder)
        End With
    
        ' add Category to each contact item in specified folder
        For Each objContactItem In objContactFolder.Items
                        
                ' check if category already exists for the item
                If InStr(1, objContactItem.Categories, strCategory, vbTextCompare) <= 0 Then
                    
                    ' add category
                    objContactItem.Categories = objContactItem.Categories & "," & strCategory
                    objContactItem.Save

                End If
        
        Next objContactItem
    
    End With
    
Exiting:
        On Error Resume Next
        
        ' memory clean up
        Set objContactItem = Nothing
        Set objContactFolder = Nothing
        Set objOutlook = Nothing
    
    Exit Sub
    
ErrorHandle:
        
        ' detailed error message
        MsgBox Err.Description
        GoTo Exiting:
    
End Sub

ADDITIONAL ONLINE RESOURCES:

  1. Rich internet applications, part 1: embedding YouTube™ video player into web page
  2. Rich internet applications, part 2: Silverlight™ media player
  3. Rich internet applications, part 3: HTML 5 video player
  4. How to select web browser and check its capabilities
  5. How to archive and back-up your online content
  6. Computer mouse triple-click is a convenient feature
  7. How to use online geocoders and interactive maps
  8. Search engine optimization and online concordance calculator

Office 2007 Outlook 2007 VB VBA Contact Category Email Outlook.Application MAPI Outlook.Folder Outlook.ContactItem

Last edited Aug 28, 2010 at 3:04 PM by DrABELL, version 8