This code sample is based on Code Sample 2 at Using VBA to Change Business Card Image & Layout.
Why would you do this? So you can "see" the category a contact is assigned to.
If you have card images on any contacts, it will replace them with the Category card image.
It only works with one category per contact. If you use multiple categories, you'll need to parse the category string to get the first category, or use
Select Case LCase(Len(oContact.Categories, 5))
where 5 is the length of your shortest category name. Enter only the first 5 letters of each category name in the Case statements.
Sub ChangeImage() Dim obj As Object Dim oFolder As Outlook.MAPIFolder Dim oContact As Outlook.ContactItem Dim colItems As Outlook.Items Dim i As Long Dim lCount As Long Dim strImage As String Set oFolder = Application.Session.GetDefaultFolder(olFolderContacts) Set colItems = oFolder.Items lCount = colItems.Count For i = 1 To lCount Set obj = colItems.Item(i) If (obj.Class = olContact) Then Set oContact = obj Select Case LCase(oContact.Categories) ' Use lower case categories in the code - LCase converts categories names to lower case Case "blue" strImage = "C:\Users\Public\Pictures\Sample Pictures\Koala.jpg" Case "green" strImage = "C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg" Case Else strImage = "C:\Users\Public\Pictures\Sample Pictures\Tulips.jpg" End Select oContact.AddBusinessCardLogoPicture (strImage) oContact.Save End If Next End Sub
If you want to skip contacts that don't match a category in your case statements, use the following code to replace the code between Case Else and End Sub in the code above.
Case Else GoTo Skip End Select oContact.AddBusinessCardLogoPicture (strImage) oContact.Save Skip: End If Next End Sub