Use this VBA to save contact photos to a folder on your hard drive.
This is an example of a 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
'Default Contacts folder
'Set fdrContacts = Session.GetDefaultFolder(olFolderContacts)
' Selected folder
Set fdrContacts = Application.ActiveExplorer.CurrentFolder
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
To save all attachments, not just contact photos, you need to remove or comment out the If statements that look for contact photos in the macro above. If you want to save all except contact photos, you would change the line to read "if the file name in not contactpicture.jpg":
If attach.Filename <> "ContactPicture.jpg" Then
Because some of the attachments might have the same file name, we'll add the contact's full name to filename.
Sub SaveContactAttachments()
Dim itemContact As ContactItem
Dim fdrContacts As MAPIFolder
Dim colAttachments As Outlook.Items
Dim colItems As Outlook.Items
Dim fname As String
'Default Contacts folder
'Set fdrContacts = Session.GetDefaultFolder(olFolderContacts)
' Selected folder
Set fdrContacts = Application.ActiveExplorer.CurrentFolder
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.FullName & "-" & attach.Filename
attach.SaveAsFile ("D:\Documents\Contact attach\" & fname)
' End If
Next
Next
End Sub
Hello. I could not find information about how Outlook 2013 manages the photos from the Contacts. I added the photos to my contacts in Outlook and still have the images in a folder. May I safely delete the images in the folder or this will also delete the Outlook Contacts pictures? Any advice is welcome! :-)
Outlook stored the image in the content's meta data. You can safely delete the pictures on the hard drive once they were added to the contact.
Hi is there a way to simply automate an email that comes in on outlook? I have emails that come in all the time of new clients and I have the social connector. I would like it when I add them to my contacts the information from LinkedIn and Facebook is added to the contact. I assumed this would do it but unless I am mistaken it does not.
That is not how it works. If you are signed in to LinkedIn and they have their photo public, you'll see their picture on the message - you can click their name to open their profile in a browser. Contacts who are linked to you will be added to the LinkedIn contacts folder in Outlook. Facebook works the same way, but does not create a contacts folder in Outlook.
If they are your linkedin friends, you can copy the contact from the linkedin folder to outlook contacts.
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 :)
These lines look for attachments, and then checks the attachment name. If it matches the attachment name outlook uses for contact photos, it saves it to a file and uses the contact's first and last name as the file name.
For Each attach In collAttachments
If attach.FileName = "ContactPicture.jpg" Then
fname = (itemContact.FirstName & itemContact.LastName & ".jpg")
attach.SaveAsFile ("C:\Contact Photos\" & fname) <== make sure you use a path that is valid.
I understand that, what I am seeing though that there aren't any attachments, or any other of the attributes I would expect from the OutlookItem object.
I added an extra line to check the hasPicture property, and this is coming back false for each Contact, even those who have a picture
I suppose this is something to do with my setup (Lync connectivity).
Thanks for the reply
Ah... it's Lync contacts - the image is synced from elsewhere when the contact loads. If you open the contact from the Lync Contacts folder, is the photo on the contact? (or use business card view) If you can see the photo on the contact, it should get it - that is how it works with linkedin in Outlook 2010. (I checked lync in Outlook, no photos, just like in 2013).
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
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
This :
GetFolderPath fdrContacts
Set fdrContacts = Session.GetDefaultFolder(olFolderContacts)
Should be
Set fdrContacts = GetFolderPath(iCloud\contacts)
So where do I find the getfolderpath function or is it builtin?
Would the path be "icloud\contacts"
I am using Outlook 2013
oh, sorry, i copied the url then forgot to paste it in. Get the function from here -
https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
The path you use will be iCloud\contacts if that is what the folder is named.
What if the contacts are not in the default folder but in the iCloud folder?
You need to use getfolderpath function and Set fdrContacts = GetFolderPath("icloud\folder-name").