If you want to get the most active contacts, you need to count how many emails you have received from each contact. This article will expose a piece of VBA code, which will do the counting for you in quick time.
At times, you may want to get who are the most active contacts in your Outlook. In other words, you would like to figure out who frequently contact you. In such a case, you have to count how many mails sent from each contacts in your Outlook. Without any doubts, manually counting is an unadvisable method. Therefore, in the followings, we will expose a piece of VBA code to help you count like a breeze.
Export the Count of Emails from Each Contact in Your Outlook to Excel
- At the very outset, launch your Outlook program.
- Then you need switch to “Developer” tab and click the “Visual Basic” button or just press “Alt + F11” keys in the main Outlook window.
- Next in the “Microsoft Visual Basic for Applications” window, open an empty module.
- Subsequently, copy and paste the following VBA codes into this module.
Sub ExportCountEmailsfromEachContacttoExcel() Dim objContacts As Outlook.Items Dim objInbox As Outlook.Folder Dim objContact As Object Dim strContactName, strContactEmailAddress As String Dim lMailsCount As Long Dim strExcelFile As String Dim objExcelApp As Excel.Application Dim objExcelWorkbook As Excel.Workbook Dim objExcelWorksheet As Excel.Worksheet Dim nNextEmptyRow As Integer 'Create an Excel file Set objExcelApp = CreateObject("Excel.Application") Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1") With objExcelWorksheet .Cells(1, 1) = "Contact Name" .Cells(1, 2) = "Contact Email Address" .Cells(1, 3) = "Emails Count" End With Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox) On Error Resume Next For Each objContact In objContacts strContactName = objContact.FullName strContactEmailAddress = objContact.Email1Address lMailsCount = 0 Call ProcessFolder(objInbox, strContactEmailAddress, lMailsCount) nNextEmptyRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 'Input the information into the Excel file objExcelWorksheet.Range("A" & nNextEmptyRow) = strContactName objExcelWorksheet.Range("B" & nNextEmptyRow) = strContactEmailAddress objExcelWorksheet.Range("C" & nNextEmptyRow) = lMailsCount Next 'Save the Excel file objExcelWorksheet.Columns("A:C").AutoFit strExcelFile = "E:\Outlook\" & "Active Contacts (" & Format(Now, "yyyy-mm-dd hh-mm-ss") & ").xlsx" objExcelWorkbook.Close True, strExcelFile MsgBox "Complete!", vbExclamation End Sub Sub ProcessFolder(objCurFolder As Outlook.Folder, strCurContactMailAddress As String, i As Long) Dim objItem As Object Dim objMail As Outlook.MailItem Dim objSubfolder As Outlook.Folder 'Count the emails from each contact For Each objItem In objCurFolder.Items If objItem.Class = olMail Then Set objMail = objItem If objMail.SenderEmailAddress = strCurContactMailAddress Then i = i + 1 End If End If Next 'Process all the subfolders under Inbox recursively If objCurFolder.Folders.Count > 0 Then For Each objSubfolder In objCurFolder.Folders Call ProcessFolder(objSubfolder, strCurContactMailAddress, i) Next End If End Sub
- After that, you can add the new macro to the Quick Access Toolbar.
- Later you should change your Outlook macro security level to low.
- Finally you can have a try. Just press the new macro in Quick Access Toolbar to trigger the new subroutine.
- After the macro completes, you can find the new Excel file in predefined local folder. It will look like the following image:
Effective Means to Rescue Your PST Data
As soon as you find your PST file inaccessible, you should raise your vigilance and take immediate actions to salvage your PST data. In general, you can apply inbox repair tool to have a try. If it fails, you should proceed to see if there is a current and valid data backup. If there is no such a backup, you can recur to a powerful external tool, 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 mdf and outlook repair software products. For more information visit www.datanumen.com