Batch Import Photos into Outlook Contacts

Last reviewed on December 30, 2013

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

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

Written by

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

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

  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 ?

  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

  7. tom1on1

    Nothing happens when I try to use it.

  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.

  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.

  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.

  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.

  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

Leave a Reply

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