Export (save) Outlook Contact photos

Last reviewed on May 22, 2013

Use this VBA to save contact photos to a folder on your hard drive.

This is an example of a contact photo:

Contact photo

To import photos into contacts, see Batch Import Photos into Outlook Contacts

Note: make sure you change the folder path in the VBA!

Sub SaveContactPhoto()

Dim itemContact As ContactItem
Dim fdrContacts As MAPIFolder
Dim colAttachments As Outlook.Items
Dim colItems As Outlook.Items

Dim fname As String

Set fdrContacts = Session.GetDefaultFolder(olFolderContacts)

On Error Resume Next

For itemCounter = 1 To fdrContacts.Items.Count

    Set itemContact = fdrContacts.Items(itemCounter)
    Set collAttachments = itemContact.Attachments

    For Each attach In collAttachments
      If attach.FileName = "ContactPicture.jpg" Then
        fname = (itemContact.FirstName & itemContact.LastName & ".jpg")
        attach.SaveAsFile ("C:\Contact Photos\" & fname)
      End If
    Next

Next

End Sub

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.

11 responses to “Export (save) Outlook Contact photos”

  1. Jim Dell

    What if the contacts are not in the default folder but in the iCloud folder?

  2. Jim Dell

    So where do I find the getfolderpath function or is it builtin?
    Would the path be "icloud\contacts"

    I am using Outlook 2013

  3. Jim Dell

    I must be doing something wrong in line 7 of the following code
    Sub SaveContactPhoto()

    Dim itemContact As ContactItem
    Dim fdrContacts As MAPIFolder
    Set fdrContacts = GetFolderPath("iCloud - Yahoo Mail")
    Dim colAttachments As Outlook.Items
    Dim colItems As Outlook.Items

    Dim fname As String

    GetFolderPath fdrContacts

    Set fdrContacts = Session.GetDefaultFolder(olFolderContacts)

    On Error Resume Next

    For itemCounter = 1 To fdrContacts.Items.Count

    Set itemContact = fdrContacts.Items(itemCounter)
    Set collAttachments = itemContact.Attachments

    For Each attach In collAttachments
    If attach.FileName = "ContactPicture.jpg" Then
    fname = (itemContact.FirstName & itemContact.LastName & ".jpg")
    attach.SaveAsFile ("H:\Contact Photos\" & fname)
    End If
    Next

    Next

    End Sub

  4. Jim Dell

    Success! Thanks.
    Here's the code in case anybody else needs to do this
    Sub SaveContactPhoto()

    Dim itemContact As ContactItem
    Dim fdrContacts As MAPIFolder

    Dim colAttachments As Outlook.Items
    Dim colItems As Outlook.Items

    Dim fname As String

    Set fdrContacts = GetFolderPath("iCloud\Contacts")

    On Error Resume Next

    For itemCounter = 1 To fdrContacts.Items.Count

    Set itemContact = fdrContacts.Items(itemCounter)
    Set collAttachments = itemContact.Attachments

    For Each attach In collAttachments
    If attach.FileName = "ContactPicture.jpg" Then
    fname = (itemContact.FirstName & itemContact.LastName & ".jpg")
    attach.SaveAsFile ("H:\Contact Photos\" & fname)
    End If
    Next

    Next

    End Sub

  5. Fiona

    Hello,

    I'm running this code but am getting some unexpected behaviour.

    The set that is returned from the call 'Session.GetDefaultFolder(olFolderContacts)' seems to be only of strings in the format "lastname, firstname" with no attachments or anything else.

    Am I missing something?

    I am using Outlook 2012 if this helps troubleshooting :)

Leave a Reply

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