Last reviewed on February 9, 2015   —  37 Comments

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

Contacts and 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)

Business cards with contact photos

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")
  
  ' use the default calendar folder
   Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items

  ' to use the selected folder use this line instead:
  '  Set myContacts = myOlApp.ActiveExplorer.CurrentFolder.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

Outlook's trust centerGo 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.

VB Editor with codeCopy 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.)

Comments

  1. Susan Thomas says

    Curious, in 2010, is it possible to point to a non default contact list? I just want to add pictures to some of my contacts and they are in a separate list.

    • Diane Poremsky says

      It is. Replace the Dim and Set for MyContacts with the following. Select the contacts you want to change and run the macro. To do the entire folder, Select All (Ctrl+A).

      Dim myContacts As Selection
      Set myContacts = Application.ActiveExplorer.Selection

  2. Ali says

    i've got a excel sheet that contain about 1500 contact, and some of them is duplicated
    every contact have an ID that linked with their picture
    how can i import my contact with picture to outlook ?

    • Diane Poremsky says

      assuming the photo is not using their email address or name, you need to pass the value of the photo name to the macro, replacing this: myContact.FullName with the id. Because its in Excel, i would probably do it from Excel - the outlook macro can be tweaked to run from excel.

    • tom1on1 says

      Do you have the VBA code for Outlook 2013? The one for 2010 does unfortunately not work. Thanks. Thomas

  3. tom1on1 says

    Migrated from Widows 7 / Outlook 2010 32-bit to Windows 8.1 / Outlook 2013 32-bit. The below code worked flawlessly for years.

    Many thanks for your help.
    Thomas

    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:\Users\TMH1203\Pictures\Outlook\" & myContact.LastName & " " & myContact.FirstName & ".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

    • Diane Poremsky says

      I missed the code here - I'll test it. As an FYI, if the comment box isn't big enough, just keep typing then press Tab to bring up the Submit button.

    • Diane Poremsky says

      I'm assuming you set a reference for the windows script host? Not doing so should trigger an error though.

    • Diane Poremsky says

      Did you enable macros in File, Options, Trust Center, Macros? It should be set to low to test or when you will be using a macro once.

  4. tom1on1 says

    Yes, in fact for test purposes I selected "Enable all Macros". Tried to send you my VBA file earlier on but was not able to copy it here.

  5. tom1on1 says

    OK, here we go (learning something new every day!):

    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:\Users\TMH1203\Pictures\Outlook\" & myContact.LastName & " " & myContact.FirstName & ".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

    • Diane Poremsky says

      Your code worked for me. To set the reference, go to tools, references in the VB editor and find Microsoft Scripting Runtime and Windows Script Host Object Model and add a check - I think you only need the Script Host Object model but i have both checked and forget why I have both checked. :) I think you have the correct one checked, otherwise you'd get an error message.

    • Diane Poremsky says

      oh, never mind, late binding sets it. You don't need it set, the macro calls it. (Can you tell its been a long day? :))
      Dim fs As Object
      Set fs = CreateObject("Scripting.FileSystemObject")

  6. tom1on1 says

    Long day... story of my life!

    Checked my Windows 7 setup. Didn't have "Microsoft Scripting Runtime" and "Windows Script Host Object Model" added. And it worked just fine.

    I did do the change on my W 8.1 PC. No change. Does not update the pictures. I will send you by email a screenshot.

    • Diane Poremsky says

      Try stepping into it and see what lines it skips - F8 or use the Debug menu or toolbar. If there were error handlers in it, i'd have you comment them out so it stops if there is a problem.

  7. tom1on1 says

    Good morning Diane

    Did extensive research on this problem. Luckily I have a very similar W 8.1 / Outlook 2013 installation on another PC. Tried the code out there and it worked just fine. Hence I went ahead and run the repair tool on my Outlook. And whatdoyousay! It now works! There was a problem with the Outlook installation. I still can’t believe it!

    Many thanks for your help. I more than appreciate it!

    With kind regards
    Thomas

    • Diane Poremsky says

      This line needs changed: Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items
      Where is the second list? If its a subfolder of the default, you can use
      Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Folders("folder-name").Items

  8. James says

    Tryed and I get an error of An obect could not be found. I have three contcts files -- Contacts, Work Contacts, and Suggested COntacts. I chnage the "folder-name" to "Work COntacts"
    Help

  9. Clark says

    Hi, could you please help me edit this Macro. I want the Macro to look at the contact Category and return a common picture for each category. I use categories to group contacts. I could write an individual macro for each category so when new contacts are added I can run the macro to automatically add pictures. Thank you Clark

    • Diane Poremsky says

      Assuming the category name = the image name, it's a simple edit - change fullname to categories:
      strPhoto = "C:\photos\" & myContact.Categories & ".jpg"

    • Clark says

      Hi, Thank you for your help, could you please write it into the Macro and post so i don't make a mistake, I am very green at this. Thank you

    • Diane Poremsky says

      all you need to do is fine this line:
      strPhoto = "C:\photos\" & myContact.FullName & ".jpg"

      and replace it with
      strPhoto = "C:\photos\" & myContact.Categories & ".jpg"

  10. Clark says

    Hi Can you please check what I have done, I cant seem to get running:

    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.Categories & ".jpg” format
    ' replace “D:\Hybrid Clark\Standard Documents\Hybrid Data\Hybrid - Icons\Outlook”
    strPhoto = “D:\Hybrid Clark\Standard Documents\Hybrid Data\Hybrid - Icons\Outlook” & myContact.Categories & “.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

    I have changed the following:

    1. ' use myContact.Categories & ".jpg” format
    2. ' replace “D:\Hybrid Clark\Standard Documents\Hybrid Data\Hybrid - Icons\Outlook”
    strPhoto = “D:\Hybrid Clark\Standard Documents\Hybrid Data\Hybrid - Icons\Outlook” & myContact.Categories & “.jpg”

    The path to the photos is long. Thanks for your help Clark

    • Diane Poremsky says

      It's working here. The category name is case sensitive - if it's Cat1 in outlook, you need to call the image Cat1. The extension needs to be correct too. Oh - and the file path needs a \ at the end "D:\Hybrid Clark\Standard Documents\Hybrid Data\Hybrid - Icons\Outlook\" - otherwise it's looking for an image called OutlookCategoryName.jpg

      Category images

  11. Clark says

    Hi, Thank you, I have it working now!! It seems to work on my default email only when i change to my other email addresses it doesn't work. Do I need to change something? Thanks again this has saved me hours and hours

    • Diane Poremsky says

      Oh, i forgot to mention - as written, its for the default contacts folder. I'll put up a version that works on selected contacts.

    • Diane Poremsky says

      Use this line to work on the selected folder:
      Set myContacts = myOlApp.ActiveExplorer.CurrentFolder.Items

      that will replace this line:
      Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

If the Post Comment button disappears, press your Tab key.