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. See "Import Images into the Active Directory" if you want to import photos into the Active Directory.
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)
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 contacts 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
Go 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.
Copy 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.)
More Information
ContactItem.AddPicture Method (MSDN)
Sample images from Portrait Illustration Maker
Change Contact's File As format
Graham says
Wow. This worked first time - I did my preparation though.
An old post but still useful. I am migrating from Gmail to O365. In Gmail the pictures can bulk be exported to CSV but endup as a http link to a JPG. I used Excel to prepare a PowerShell WGET to pull down the JPG and name it correctly. Then ran your script.
MS instructions to export/import without photos.
=IF(ISBLANK([@Photo]),,CONCAT("wget ",[@Photo]," -outfile """,[@Name],".jpg"""))Thank you so much.
Rob says
How do I set all contacts where the CompanyName is 'Acme' (for example) to update with a set photo? So I have one image I would like to apply to all contacts in one company but not touch any other contacts, how do I do that please?
Diane Poremsky says
Change myContact.FullName to myContact.companyname - and name the image to match the company name. this will change all contacts to use company logos as the photo. If only contacts from acme need the photo matched to the company name, editing the macro to work with selected contacts might be easier - then select all contacts from one company and run it. https://www.slipstick.com/developer/code-samples/working-items-folder-selected-items/
now... do you really want to use the photo in the contact or add the image to the business card view? i have a macro for that too.
Curtis Spurlock says
When I ran the macro I got an error:
Run time error 91:
Object or With block variable not set
Steven Reames says
This is brilliant. I imported my photo file name to a user field in Outlook and linked it from there instead of cross referencing to another table.
Can I buy you coffee today?
enrique@ibicsa.co.cu says
whats happen if i don this process in my pc , them export address book to import in other s workstation? is possible? thaks srry abaut my english
Diane Poremsky says
if you export to a pst file, you'll be fine. If you export to a csv, you won't have the images.
Syed Nazar says
Guys there is a easy no need to write and execute the Script use this software and very simple to upload photos
[software name removed]
Diane Poremsky says
If you had read the page, you'd know the script on this page tells end-users how to import photos into their Outlook Contacts, not into the Active Directory.
PowerShell scripts to bulk import into the AD are at Import Images into the Active Directory. That page has a list of utilities for those who don't want to use PowerShell directly.
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
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
Clark says
Thank you I will give it a go
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"
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
Diane Poremsky says
is work contacts a subfolder under contacts? is this in iCloud folders?
James says
I have two contact list, how do I point to the second list to add photos.
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
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
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.
tom1on1 says
No, I didn't. Not sure how to do that.
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")
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
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.
Diane Poremsky says
send it to feedback@slipstick.com and I'll take a look at it.
tom1on1 says
Nothing happens when I try to use it.
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.
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.
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
Diane Poremsky says
It should work. What error message do you get? What happens when you try to use it?
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
Lars says
Perfectly! This just worked fine for me and saved me hours to update nearly 400 contacts. Thank you!
funluckykitty says
Figured out.. pretty easy to just add a connection string, query the db, and then loop thru.
funluckykitty says
Curious to see how to do a sql lookup to get the names of the pictures. Is that possible from this vba?