How to export contacts’ information along with photos in Outlook?
When you export contacts from Outlook to a file, only the text information of the contacts can be exported. But, sometimes, you need the photos to be exported as well as the contacts’ text information, how could you deal with this task in Outlook?
Export contacts'information with relative photos by using VBA code
Export contacts’ information with relative photos by using VBA code
The below VBA code can help you to export all contacts in a specific contact folder to separate text file with photos. Please do as this:
1. Select a contact folder which you want to export the contacts with photos.
2. And then, hold down the "ALT" + "F11" keys to open the "Microsoft Visual Basic for Applications" window.
3. Then, click "Insert" > "Module", copy and paste below code into the opened blank module, see screenshot:
VBA code: export contacts’ information with photos
Sub BatchExportContactPhotosandInformation()
Dim xContactItems As Outlook.Items
Dim xItem As Object
Dim xContactItem As ContactItem
Dim xContactInfo As String
Dim xShell As Object
Dim xFSO As Scripting.FileSystemObject
Dim xTextFile As Scripting.TextStream
Dim xAttachments As Attachments
Dim xAttachment As Attachment
Dim xSavePath, xEmailAddress As String
Dim xFolder As Outlook.Folder
On Error Resume Next
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xShell = CreateObject("Shell.application").BrowseforFolder(0, "Select a Folder", 0, 16)
If xShell Is Nothing Then Exit Sub
xSavePath = xShell.Items.Item.Path & "\"
If Outlook.Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
Set xFolder = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
Else
Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
End If
Set xContactItems = xFolder.Items
For i = xContactItems.Count To 1 Step -1
Set xItem = xContactItems.Item(i)
If xItem.Class = olContact Then
Set xContactItem = xItem
With xContactItem
xEmailAddress = .Email1Address
If Len(Trim(.Email2Address)) <> 0 Then
xEmailAddress = xEmailAddress & ";" & .Email2Address
End If
If Len(Trim(.Email3Address)) <> 0 Then
xEmailAddress = xEmailAddress & ";" & .Email3Address
End If
xContactInfo = "Name: " & .FullName & vbCrLf & "Email: " & _
xEmailAddress & vbCrLf & "Company: " & .CompanyName & _
vbCrLf & "Department: " & .Department & _
vbCrLf & "Job Title: " & .JobTitle & _
vbCrLf & "IM: " & .IMAddress & _
vbCrLf & "Business Phone: " & .BusinessTelephoneNumber & _
vbCrLf & "Home Phone: " & .HomeTelephoneNumber & _
vbCrLf & "BusinessFax Phone: " & .BusinessFaxNumber & _
vbCrLf & "Mobile Phone: " & .MobileTelephoneNumber & _
vbCrLf & "Business Address: " & .BusinessAddress
Set xTextFile = xFSO.CreateTextFile(xSavePath & .FullName & ".txt", True)
xTextFile.WriteLine xContactInfo
If .Attachments.Count > 0 Then
Set xAttachments = .Attachments
For Each xAttachment In xAttachments
If InStr(LCase(xAttachment.FileName), "contactpicture.jpg") > 0 Then
xAttachment.SaveAsFile (xSavePath & .FullName & ".jpg")
End If
Next
End If
End With
End If
Next i
End Sub
4. After pasting the code into the module, go on clicking "Tools" > "References" in the "Microsoft Visual Basic for Applications" window, in the popped out "References-Project1" dialog box, check "Microsoft Scripting Runtime" option from the "Available References" list box, see screenshot:
5. Click "OK" to close the dialog, and then press "F5" key to run this code, in the popped out "Browse For Folder" dialog box, specify a folder where you want to output the exported contacts, see screenshot:
6. Then click "OK", all information with the photos of the contacts have been exported to your specific folder separately, see screenshot:
Best Office Productivity Tools
Breaking News: Kutools for Outlook Launches Free Version!
Experience the all-new Kutools for Outlook with 100+ incredible features! Click to download now!
📧 Email Automation: Auto Reply (Available for POP and IMAP) / Schedule Send Emails / Auto CC/BCC by Rules When Sending Email / Auto Forward (Advanced Rules) / Auto Add Greeting / Automatically Split Multi-Recipient Emails into Individual Messages ...
📨 Email Management: Recall Emails / Block Scam Emails by Subjects and Others / Delete Duplicate Emails / Advanced Search / Consolidate Folders ...
📁 Attachments Pro: Batch Save / Batch Detach / Batch Compress / Auto Save / Auto Detach / Auto Compress ...
🌟 Interface Magic: 😊More Pretty and Cool Emojis / Remind you when important emails come / Minimize Outlook Instead of Closing ...
👍 One-click Wonders: Reply All with Attachments / Anti-Phishing Emails / 🕘Show Sender's Time Zone ...
👩🏼🤝👩🏻 Contacts & Calendar: Batch Add Contacts From Selected Emails / Split a Contact Group to Individual Groups / Remove Birthday Reminders ...
Use Kutools in your preferred language – supports English, Spanish, German, French, Chinese, and 40+ others!
🚀 One-Click Download — Get All Office Add-ins
Strongly Recommended: Kutools for Office (5-in-1)
One click to download five installers at once — Kutools for Excel, Outlook, Word, PowerPoint and Office Tab Pro. Click to download now!
- ✅ One-click convenience: Download all five setup packages in a single action.
- 🚀 Ready for any Office task: Install the add-ins you need, when you need them.
- 🧰 Included: Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint