How to Auto Record the Total Count of Incoming Emails Every Day in an Excel File

This article will teach you how to let Outlook automatically count how many emails you received every day and write the number into an Excel file.

Many users are required to count the total number of emails received each day. In addition, for more convenient check in future, many are accustomed to recording the total count into an Excel file. In this case, of course you can opt to count and record manually every day. However, it is a bit troublesome. And you may forget doing it sometimes. Therefore, you must desire a handy method, which can make Outlook to automatically do it. In response to this requirement, we will teach you how to use VBA to realize it in the followings.

Auto Record the Total Count of Incoming Emails Every Day in an Excel File

1. At the very outset, launch your Outlook application.
2. Then press “Alt + F11” key shortcuts in the main Outlook window.
3. Next in the popup VBA editor window, open “ThisOutlookSession” project.
4. Subsequently, copy and paste the following VBA codes into this project.

Private Sub Application_Reminder(ByVal Item As Object)
    If Item.Class = olTask And Item.Subject = "Update Email Count" Then
       Call GetAllInboxFolders
    End If
End Sub

Private Sub GetAllInboxFolders()
    Dim objInboxFolder As Outlook.Folder
    Dim strExcelFile As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim lEmailCount As Long
 
    lEmailCount = 0
    Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Call UpdateEmailCount(objInboxFolder, lEmailCount)
 
    ‘Change the path to the Excel file
    strExcelFile = "E:\Email\Email Count.xlsx"
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
 
    nNextEmptyRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
    'Add the values into the columns
    objExcelWorksheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorksheet.Range("B" & nNextEmptyRow) = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
    objExcelWorksheet.Range("C" & nNextEmptyRow) = lEmailCount
 
    'Fit the columns from A to C
    objExcelWorksheet.Columns("A:C").AutoFit
   
    'Save the changes and close the Excel file
    objExcelWorkbook.Close SaveChanges:=True
End Sub

Private Sub UpdateEmailCount(objFolder As Outlook.Folder, ByRef lCurEmailCount As Long)
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strDay As String
    Dim strReceivedDate As String
    Dim lEmailCount As Long
    Dim objSubFolder As Outlook.Folder
 
    Set objItems = objFolder.Items
 
    objItems.SetColumns ("ReceivedTime")
    strDay = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
 
    For Each objItem In objItems
        If objItem.Class = olMail Then
           Set objMail = objItem
           strReceivedDate = Year(objMail.ReceivedTime) & "-" & Month(objMail.ReceivedTime) & "-" & Day(objMail.ReceivedTime)
           If strReceivedDate = strDay Then
              lCurEmailCount = lCurEmailCount + 1
           End If
        End If
    Next
 
    'Process the subfolders in the folder recursively
    If (objFolder.Folders.Count > 0) Then
       For Each objSubFolder In objFolder.Folders
           Call UpdateEmailCount(objSubFolder, lCurEmailCount)
       Next
    End If
End Sub

5. Next, sign this code and change your Outlook macro settings to allow signed macros.
6. After that, you need to create a recurring task on daily basis.

• Firstly, click “New Task” button in Tasks pane.
• In the popup New Task window, click “Recurrence” button.
• Then in the subsequent dialog box, select “Daily”, “Every 1 day(s)” and “No end date” and lastly hit “OK”.
• Later change the task subject and reminder as per your needs.
• Eventually click “Save & Close” button.

7. From now on, every time this task’s reminder alerts, Outlook will auto count the emails received yesterday and then record the number into the Excel file, like the following screenshot:

Escape from Permanent PST Data Loss

No one is willing to accept permanent PST data loss. However, Outlook PST file is prone to corruption. Therefore, you should make sufficient precautions, such as making a consistent and up-to-date PST data backup and keeping a powerful PST recovery tool in vicinity, like 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 sql repair and outlook repair software products. For more information visit www.datanumen.com