Skip to main content

 How to export contacts’ information 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)
    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
            End If
        End With
    End If
Next i
End Sub

doc export contacts with photos 1

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:

doc export contacts with photos 2

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:

doc export contacts with photos 3

6. Then click OK, all information with the photos of the contacts have been exported to your specific folder separately, see screenshot:

doc export contacts with photos 4

Best Office Productivity Tools

Kutools for Outlook - Over 100 Powerful Features to Supercharge Your Outlook

Email Automation: Auto Reply (Out of Office)  /  Schedule Send emails  /  Auto CC/BCC  /  Advanced Auto Forward  /  Auto Add Greating ...

Email Management: Easily Recall Emails  /  Block Scam Emails  /  Delete Duplicate Emails  /  🔎Advanced Search  /  Consolidate Folders ...

📁 Attachments ProBatch Save  /  Batch Detach  /  Batch Compress  /  Auto Save   /  Auto Detach  /  Auto Compress ...

🌟 Interface & Interaction Magic: 😊More Pretty and Cool Emojis   /  Brings Browser Tabs Right Into Your Outlook  /  Minimize Outlook Instead of Closing ...

👍 One-click Wonders: Reply All with Incoming Attachments  /   Anti-Phishing Emails  /  🕘Show Sender's Time Zone  /  Send to Recipients Separately ...

👩🏼‍🤝‍👩🏻 Contacts & Calendar: Batch Add Contacts From Selected Emails  /  Split a Contact Group to Individual Groups  /  Remove Birthday Reminders ...

Over 100 Features Await Your Exploration! Click Here to Discover More.

Read More       Free Download      Purchase
Comments (2)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Do you know that many (every ?) OpenSource alternative to Outlook are able to export contacts in vcard format, with all details and photos ?
Just with one click, no need to write any code...
Incredible, isn't it ?
This comment was minimized by the moderator on the site
It's because Oulook / Exchange are not free, you need to pay for everything ! :-)
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
Rate this post:
0   Characters
Suggested Locations