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

1. First off, trigger Outlook VBA editor according to “How to Run VBA Code in Your Outlook“.
2. Then, in the new window, activate the reference to “MS Excel Object Library” by reading “How to Add an Object Library Reference in VBA“.
3. 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

4. After that, click into the first subroutine and press “F5” key button.
5. 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.

Author Introduction:

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