If you need to extract all the contacts’ phone numbers and print them in list, you can use the method introduced in this article. It can let you achieve this in one go.
Perhaps you have input phone numbers to all contacts in your Outlook. Then, you may wish to create and print a phone book from Outlook. That refers to getting the list of all contacts’ phone numbers and printing this list. Now, thereinafter, we will introduce a quick method. It can save you from manually extracting contacts’ phone numbers one by one.
Quickly Print a List of All Contacts’ Phone Numbers
- First off, trigger Outlook VBA editor according to “How to Run VBA Code in Your Outlook“.
- Then, in the new window, activate the reference to “MS Excel Object Library” by reading “How to Add an Object Library Reference in VBA“.
- Next, put the following VBA code into a module.
Dim objExcelApp As Excel.Application Dim objExcelWorkbook As Excel.Workbook Dim objExcelWorksheet As Excel.Worksheet Sub PrintListPhoneNumbers() Dim objStore As Outlook.Store Set objExcelApp = CreateObject("Excel.Application") Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Sheets(1) objExcelApp.Visible = True With objExcelWorksheet .Cells(1, 1) = "Contact" .Cells(1, 1).Font.Bold = True .Cells(1, 2) = "Business" .Cells(1, 2).Font.Bold = True .Cells(1, 3) = "Home" .Cells(1, 3).Font.Bold = True .Cells(1, 4) = "Other" .Cells(1, 4).Font.Bold = True End With For Each objStore In Application.Session.Stores Call ProcessFolders(objStore.GetRootFolder.Folders) Next objExcelWorksheet.Columns("A:D").AutoFit objExcelWorksheet.PrintOut objExcelWorkbook.Close False objExcelApp.Quit End Sub Sub ProcessFolders(ByVal objFolders As Outlook.Folders) Dim objFolder As Outlook.Folder Dim i As Long Dim objContact As Outlook.ContactItem Dim nLastRow As Integer Dim objSubfolder As Outlook.Folder For Each objFolder In objFolders If objFolder.DefaultItemType = olContactItem Then For i = objFolder.Items.Count To 1 Step -1 If objFolder.Items(i).Class = olContact Then Set objContact = objFolder.Items(i) If objContact.BusinessTelephoneNumber <> "" Or objContact.HomeTelephoneNumber <> "" Or objContact.OtherTelephoneNumber <> "" Then nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 With objExcelWorksheet .Range("A" & nLastRow) = objContact.FullName .Range("B" & nLastRow) = objContact.BusinessTelephoneNumber .Range("C" & nLastRow) = objContact.HomeTelephoneNumber .Range("D" & nLastRow) = objContact.OtherTelephoneNumber End With End If End If Next If objFolder.Folders.Count > 0 Then Call ProcessFolders(objFolder.Folders) End If End If Next End Sub
- After that, click into the first subroutine and press “F5” key button.
- At once, a list of all your contacts’ phone numbers will be printed, as shown in the following screenshot.
Take Care of Your Outlook Well
As we all know, it is a bit hard to predicate and evade Outlook errors. Therefore, what we can do is to make some precautions in advance. Simply put, you ought to make data backups for Outlook periodically. Plus, you should look out for all the hidden viruses or malware in emails. Last but not least, you had better get hold of a powerful and reliable Outlook fix tool, like DataNumen Outlook Repair. It is able to repair Outlook file in a jiffy.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including recover mdf and outlook repair software products. For more information visit www.datanumen.com