Change the image on a Business Card based on the Category

This code sample is based on Code Sample 2 at Using VBA to Change Business Card Image & Layout.

This code checks every contact in the default Contacts folder and adds a business card image based on the assigned category.

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