Just with one click, no need to write any code...
Incredible, isn't it ?
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
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: