RSSThis 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.
Notes
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
More Information
Change the Business Card layout using BusinessCardLayoutXml
Using Arrays in Outlook macros
Get text using Left, Right, Mid, Len, InStr
