Use these code samples when you want to change the background color, move the business card image from the left side or change or rearrange the fields.

The first sample applies to all contacts in the folder, while the second sample works on just the selected contacts.

Code Sample 3: Change the business card layout to match the selected contact

To use, first edit a business card so it is exactly as you want then run the macro.

To use this code, select the contact whose card you edited then run the macro to apply it to all contacts in the folder. As with Sample 2, you can use If... Then statements to apply it to specific contacts.

Public Sub CustomizeBusinessCards()
Dim obj As Object
Dim oFolder As Outlook.MAPIFolder
Dim oContact As Outlook.ContactItem
Dim oModel As Outlook.ContactItem
Dim colItems As Outlook.Items
Dim i As Long
Dim lCount As Long
Dim sXML As String

Set oFolder = Application.Session.GetDefaultFolder(olFolderContacts)
Set colItems = oFolder.Items

Set oModel = Application.ActiveExplorer.Selection.Item(1)

sXML = oModel.BusinessCardLayoutXml

lCount = colItems.Count
For i = 1 To lCount
Set obj = colItems.Item(i)
If (obj.Class = olContact) Then
Set oContact = obj
  oContact.BusinessCardLayoutXml = sXML
 ' oContact.AddBusinessCardLogoPicture ("C:\image\logo.gif")
  oContact.Save
End If
Next
End Sub

Code Sample 4: Change the business card layout of selected contacts

To use this code sample, after changing one contact's business card, select the contact then select the contacts you want to match the first contact's business card layout to the remaining selected contacts. For example, if you select Billy, Bob, and Mary's contacts, the layout on Billy's card is applied to Bob and Mary's contacts. Use this when you want to change the background color, move the business card image from the left side or change or rearrange the fields.

Public Sub ChangeBusinessCardXML_SelectedContacts()
    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim folder As Outlook.folder
    Dim oModel As Outlook.ContactItem
    Dim sXML As String
    Dim obj As Object

    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection

'uses the xml of first item selected to set the other cards that are selected
   Set oModel = Application.ActiveExplorer.Selection.Item(1)
   sXML = oModel.BusinessCardLayoutXml

    On Error Resume Next
    For Each obj In Selection
    Set folder = currentItem.Parent
        'Test for contact and not distribution list
        If obj.Class = olContact Then
            Set objContact = obj

      With objContact

        obj.BusinessCardLayoutXml = sXML
        'obj.AddBusinessCardLogoPicture ("C:\image\logo.gif")
        .Save

     End With

        End If
        Err.Clear
    Next

    Set Session = Nothing
    Set currentExplorer = Nothing
    Set obj = Nothing
    Set Selection = Nothing
    Set currentItem = Nothing
    Set folder = Nothing
End Sub

If you have your own code, below are the (important) parts of the code that will allow you to get the business card layout of the selected contact item then apply it to the remaining contacts.

'dim the variables
   Dim oModel As Outlook.ContactItem
   Dim sXML As String

'use the xml of first selected item to set the other cards
   Set oModel = Application.ActiveExplorer.Selection.Item(1)
   sXML = oModel.BusinessCardLayoutXml

'apply the changes
      With objContact
        obj.BusinessCardLayoutXml = sXML
        .save
     End With