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: