If you want to export your Outlook contacts in different companies to the different worksheets of an Excel workbook, you can refer to this article. Here we will help you get it quickly.
As we all know, it is considerably easy to export Outlook contacts to an Excel file. You can simply make use of the inbuilt “Export” feature. However, by this means, all contacts will be totally exported to the same worksheet of an Excel workbook. If you want to export contacts to different worksheets as per the companies, you have to use other methods, such as the following one.
Export Contacts in Different Companies to Different Worksheets of an Excel Workbook
- To start with, access Outlook VBA editor according to “How to Run VBA Code in Your Outlook“.
- Then, enable “MS Excel Object Library” by referring to “How to Add an Object Library Reference in VBA“.
- Next, copy the following VBA code into a module that is not in use.
Sub ExportContacts_DifferentCompanies_DifferentSheets() Dim objContacts As Outlook.Items Dim objItem As Object Dim objContact As Outlook.ContactItem Dim objDictionary As Object Dim strCompany As String Dim objExcelApp As Excel.Application Dim objWorkbook As Excel.Workbook Dim objWorksheet As Excel.Worksheet Dim varKey As Variant Dim strKey As String Dim i As Long Dim bSheetFound As Boolean Dim nLastRow As Integer Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items Set objDictionary = CreateObject("Scripting.Dictionary") For Each objItem In objContacts If objItem.Class = olContact Then Set objContact = objItem strCompany = objContact.CompanyName If objDictionary.Exists(strCompany) = False Then objDictionary.Add strCompany, 0 End If End If Next Set objExcelApp = CreateObject("Excel.Application") Set objWorkbook = objExcelApp.Workbooks.Add objExcelApp.Visible = True i = 0 For Each varKey In objDictionary.Keys strKey = CStr(varKey) On Error Resume Next objWorkbook.Sheets(strKey).Select bSheetFound = (Err = 0) On Error GoTo 0 If bSheetFound = False Then i = i + 1 If i < 4 Then Set objWorksheet = objWorkbook.Sheets(i) Else Set objWorksheet = objWorkbook.Sheets.Add(After:=objWorkbook.Sheets(objWorkbook.Sheets.Count)) End If objWorksheet.Name = strKey End If With objWorksheet .Cells(1, 1) = "Name" .Cells(1, 1).Font.Bold = True .Cells(1, 2) = "Email" .Cells(1, 2).Font.Bold = True .Cells(1, 3) = "Tel" .Cells(1, 3).Font.Bold = True End With For Each objItem In objContacts If objItem.Class = olContact Then Set objContact = objItem If objContact.CompanyName = strKey Then nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1 With objWorksheet .Range("A" & nLastRow) = objContact.FullName .Range("B" & nLastRow) = objContact.Email1Address .Range("C" & nLastRow) = objContact.BusinessTelephoneNumber End With End If End If Next objWorksheet.Columns("A:C").AutoFit Next End Sub
- After that, run this macro either by clicking “Run” icon or pressing “F5” key.
- Finally, when macro finishes, a new Excel workbook will display.
- As you can see, the contacts of different companies have been exported into different worksheets, like the screenshot below.
Repair Annoying Outlook Problems
If you deal with your Outlook improperly, such as frequently closing Outlook in a wrong manner, your Outlook will be subject to various problems. Without any doubts, Outlook corruption is the most terrible one. In face of it, if you don’t have effective backups, the unique solution is to utilize a robust external PST fix utility, such as DataNumen Outlook Repair.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupt SQL Server and outlook repair software products. For more information visit www.datanumen.com