How to Quickly Export the Count of Emails from Each Contact in Your Outlook to Excel

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.

Quickly Export the Count of Emails from Each Contact in Your Outlook to Excel

Export the Count of Emails from Each Contact in Your Outlook to Excel

  1. At the very outset, launch your Outlook program.
  2. Then you need switch to “Developer” tab and click the “Visual Basic” button or just press “Alt + F11” keys in the main Outlook window.
  3. Next in the “Microsoft Visual Basic for Applications” window, open an empty module.
  4. 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

VBA Code - Export the Count of Emails from Each Contact to Excel

  1. After that, you can add the new macro to the Quick Access Toolbar.
  2. Later you should change your Outlook macro security level to low.
  3. Finally you can have a try. Just press the new macro in Quick Access Toolbar to trigger the new subroutine.
  4. After the macro completes, you can find the new Excel file in predefined local folder. It will look like the following image:Count Emails from Each Contact

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.

Author Introduction:

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

Comments are closed.