Batch Import Photos into Outlook Contacts

Beginning with Outlook 2003, you could add contact photos to your contacts. Each contact needs to edited to add the image, however you can use VBA to automate the process. For best results, the image needs to be named the same as the contact, otherwise you need to use a lookup table to associate names with pictures.

To export contact photos to a folder on the hard drive, see Export (save) Outlook Contact photos

If the contact has a picture assigned and one exists in the folder, it will be replaced. If no picture exists, the contact is skipped. The screenshots below are before and after shots of the business card view. (Contact pictures are from Portrait Illustration Maker)

You can use the full name , "last, first" or FileAs format for the image name by changing the following line in the code (don't forget to change the file path and file extension if needed.):

strPhoto = "C:\photos\" & myContact.FullName & ".jpg"

myContact.FileAs uses the file as format on each contact
myContact.FullName for "first last.jpg" name format, ie "diane poremsky.jpg"
myContact.LastNameAndFirstName results in "last, first.jpg" format, or "poremsky, diane.jpg"

You can make up your own formats using Outlook fields. For example, if the file name is last first with no comma and a space (Poremsky Diane.jpg) use
strPhoto = "C:\photos\" & myContact.LastName & " " & myContact.FirstName & ".jpg"

If the names are lastfirst without a space (poremskydiane.jpg), use
strPhoto = "C:\photos\" & myContact.LastName & myContact.FirstName & ".jpg"

VBA code sample

Tested in Outlook 2007 and 2010.

Public Sub UpdateContactPhoto()
    Dim myOlApp As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myContacts As Outlook.Items
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items

    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    For Each myItem In myContacts
        If (myItem.Class = olContact) Then
            Dim myContact As Outlook.ContactItem
            Set myContact = myItem

            Dim strPhoto As String
            
      '  use myContact.LastNameAndFirstName = "last, first.jpg" format
      '  replace "C:\photos\" with the correct path. 
            strPhoto = "C:\photos\" & myContact.FullName & ".jpg"
            
     ' use for testing only, to confirm the path is correct. 
     ' Delete or comment out 
 	 ' MsgBox (strPhoto)
                  
                  
            If fs.FileExists(strPhoto) Then
                myContact.AddPicture strPhoto
                myContact.Save
            End If
        End If
    Next
End Sub

How to use the code

Go to the Trust center and make macros are configured to notify. (File, Options, Trust center in Outlook 2010, Tools, Trust center in Outlook 2007.)

Close and restart Outlook.

Press Alt+F11 to open the VBA editor and double click on ThisOutlookSession to open it in the editor.

Copy and paste the code into ThisOutlookSession.

Press the Run button (F5) to run the macro now. To run it later, use the Tools, Macro command (Outlook 2007).

Uncomment the 'MsgBox (strPhoto) line and run to verify the file path is correct. (Uncomment the line by removing the apostrophe from in front of the line.)

Related Posts:

1. 

   Export (save) Outlook Contact photos
2. 

   Import Images into the Active Directory
3. 

   Use Instant search to find messages from a contact
4. How to keep the name of an attachment in a message after using VBA to

   Delete attachments from messages