If you want to count the contacts by city in your Outlook, you can refer to this article. Here we will teach you a quick and simple way, which is able to quickly export the count to an Excel file.
Perhaps you have stored a great amount of contacts with detailed information in your Outlook. In this scenario, at times, you may want to count the contacts on different basses, such as counting contacts by color categories, by company or by business address. Now, here we’ll share a piece of VBA code, which can allow you to quickly export the count of contacts based on business address city to Excel.
Get the Count of Outlook Contacts in Each City
- To begin with, start your Outlook application.
- Then, press “Alt + F11” key buttons to access VBA editor.
- Next, in the “Microsoft Visual Basic for Applications” window, copy and paste the following code into a new module.
Sub CountContactsbyCity() Dim objContacts As Outlook.Items Dim objItem As Object Dim objContact As Outlook.ContactItem Dim strAddressCity As String Dim objDictionary As Object Dim objExcelApp As Excel.Application Dim objExcelWorkbook As Excel.Workbook Dim objExcelWorksheet As Excel.Worksheet Dim nLastRow As Integer Dim varAddressCities As Variant Dim varContactCounts As Variant Dim i As Long Set objContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items Set objDictionary = CreateObject("Scripting.Dictionary") For Each objItem In objContacts If TypeOf objItem Is ContactItem Then Set objContact = objItem strAddressCity = Trim(objContact.BusinessAddressCity) If Len(strAddressCity) > 0 Then If objDictionary.Exists(strAddressCity) Then objDictionary.Item(strAddressCity) = objDictionary.Item(strAddressCity) + 1 Else objDictionary.Add strAddressCity, 1 End If End If End If Next Set objExcelApp = CreateObject("Excel.Application") Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Sheets(1) objExcelApp.Visible = True With objExcelWorksheet .Cells.Font.Name = "Cambria" .Cells(1, 1) = "Address City" .Cells(1, 1).Font.Size = 12 .Cells(1, 1).Font.Bold = True .Cells(1, 2) = "Contact Count" .Cells(1, 2).Font.Size = 12 .Cells(1, 2).Font.Bold = True End With varAddressCities = objDictionary.Keys varContactCounts = objDictionary.Items For i = LBound(varAddressCities) To UBound(varAddressCities) nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 With objExcelWorksheet .Cells(nLastRow, 1) = varAddressCities(i) .Cells(nLastRow, 2) = varContactCounts(i) End With Next objExcelWorksheet.Columns("A:B").AutoFit End Sub
- After that, trigger this macro right now. Just tap on “F5” button in the current macro.
- Finally, when the macro completes, you will get a new Excel file displaying. It will look like the following screenshot:
Restore Outlook Data after Severe Corruption
To be honest, it is impossible to predict when Outlook will crash or get corrupted. What a regular user can do to prevent Outlook damage is to keep well-prepared all the time. For example, you have to make PST data backup on a regular basis. If possible, it is always suggested to invest in a powerful and credible PST fix utility, such as DataNumen Outlook Repair. It’s because the inbox repair tool is unable to deal with serious Outlook damage. Hence, if you encounter severe corruption, the external tool will come to your rescue in time.
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