Batch Import Photos into Outlook Contacts

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.)

About Diane Poremsky

Diane Poremsky
A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

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

37 responses to “Batch Import Photos into Outlook Contacts”

  1. funluckykitty

    Curious to see how to do a sql lookup to get the names of the pictures. Is that possible from this vba?

  2. funluckykitty

    Figured out.. pretty easy to just add a connection string, query the db, and then loop thru.

  3. Lars

    Perfectly! This just worked fine for me and saved me hours to update nearly 400 contacts. Thank you!

  4. Susan Thomas

    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.

    1. Diane Poremsky

      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

  5. Ali

    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 ?

    1. Diane Poremsky

      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.

    2. tom1on1

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

    3. Diane Poremsky

      It should work. What error message do you get? What happens when you try to use it?

  6. tom1on1

    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

    1. Diane Poremsky

      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.

    2. Diane Poremsky

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

  7. tom1on1

    Nothing happens when I try to use it.

    1. Diane Poremsky

      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.

  8. tom1on1

    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.

    1. Diane Poremsky

      send it to feedback@slipstick.com and I'll take a look at it.

  9. tom1on1

    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

  10. tom1on1

    No, I didn't. Not sure how to do that.

    1. Diane Poremsky

      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.

    2. Diane Poremsky

      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")

  11. tom1on1

    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.

    1. Diane Poremsky

      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.

  12. tom1on1

    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

  13. James

    I have two contact list, how do I point to the second list to add photos.

    1. Diane Poremsky

      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

  14. James

    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

    1. Diane Poremsky

      is work contacts a subfolder under contacts? is this in iCloud folders?

  15. Clark

    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

    1. Diane Poremsky

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

    2. Clark

      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

    3. Diane Poremsky

      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"

  16. Clark

    Thank you I will give it a go

  17. Clark

    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

    1. Diane Poremsky

      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

  18. Clark

    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

    1. Diane Poremsky

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

    2. Diane Poremsky

      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

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

This site uses XenWord.