In Outlook, inbuilt “Export” feature only supports to export contacts’ information, not including the contact photos. So, if you want to export both information and photos, you can use the way introduced in this article.
When it comes to exporting something from Outlook, you will surely think about using the built-in “Export” feature. However, by this means, it can only export the textual information. For example, if you want to export both the information and photos of the Outlook contacts, the inbuilt way isn’t the best choice. You’re better off using the following way.
Batch Export Information and Photos of All Outlook Contacts to Excel
- At first, launch Outlook application.
- Then, trigger Outlook VBA editor according to “How to Run VBA Code in Your Outlook“.
- Next, copy and paste the following VBA code into a module.
Sub BatchExportContactPhotosandInformation() Dim objContacts As Outlook.Items Dim objContact As ContactItem Dim objAttachment As Attachment Dim objExcelApp As Object Dim objExcelWorkbook As Object Dim objExcelWorksheet As Object Dim nLastRow As Integer Dim strPhoto As String Set objContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items 'Create a New Excel File Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = True Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Sheets(1) With objExcelWorksheet .Cells(1, 1) = "Name" .Cells(1, 1).Font.Bold = True .Cells(1, 2) = "Photo" .Cells(1, 2).Font.Bold = True .Cells(1, 3) = "Email" .Cells(1, 3).Font.Bold = True .Cells(1, 4) = "Tel" .Cells(1, 4).Font.Bold = True .Cells(1, 5) = "Address" .Cells(1, 5).Font.Bold = True End With For Each objItem In objContacts If TypeOf objItem Is ContactItem Then nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 Set objContact = objItem 'Export Information to Excel With objExcelWorksheet .Cells(nLastRow, 1) = objContact.FullName .Cells(nLastRow, 3) = objContact.Email1Address .Cells(nLastRow, 4) = objContact.BusinessTelephoneNumber .Cells(nLastRow, 5) = objContact.BusinessAddress End With 'Export Photos to Excel If objContact.Attachments.Count > 0 Then For Each objAttachment In objContact.Attachments If InStr(LCase(objAttachment.FileName), "contactpicture.jpg") > 0 Then strPhoto = "E:\" & objContact.FullName & ".jpg" objAttachment.SaveAsFile strPhoto With objExcelWorksheet .Range("B" & nLastRow).ColumnWidth = 9 .Range("B" & nLastRow).RowHeight = 51 .Range("B" & nLastRow).Activate With .Pictures.Insert(strPhoto) With .ShapeRange .LockAspectRatio = msoFalse .Width = 50 .Height = 50 End With End With End With End If Next Kill strPhoto Else objExcelWorksheet.Range("B" & nLastRow).RowHeight = 15 End If End If Next 'Align Excel Cells objExcelWorksheet.Columns("A").AutoFit objExcelWorksheet.Columns("C:E").AutoFit objExcelWorksheet.Rows("1:1").HorizontalAlignment = xlCenter objExcelWorksheet.UsedRange.VerticalAlignment = xlCenter End Sub
- After that, press “F5” key button to run this macro.
- At once, an Excel file will be displayed, which looks like the following figure.
About Outlook Data Protection
Many Outlook users still don’t pay much attention to Outlook data protection. But they’ll regret a lot when they encounter Outlook corruption. In honesty, it is very important for you to make efforts to safeguard your Outlook data file against all risks. For instance, you back up Outlook at regular interval. Plus, if possible, you’d better keep a professional Outlook recovery tool nearby, like DataNumen Outlook Repair.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupted sql and outlook repair software products. For more information visit www.datanumen.com