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