If you store sent emails in several folders and now would like to count all these sent mails by month, you can read this article. Here we will introduce a considerably fast way to get it.
The previous article – “How to Quickly Count Incoming Emails by Date, Month or Year via Outlook VBA” has shared a way to count emails by month. However, it is able to process the emails in one folder. If you want to count emails in several or even all the mail folders, you should use the other means. Thus, in the followings, we will expose another much quicker way to you.
Count the Sent Emails by Month
- To begin with, access Outlook VBA editor via “Alt + F11”.
- Then, enable reference to “MS Excel Object Library” according to “How to Add an Object Library Reference in VBA“.
- After that, put the following VBA code into a project or module.
Dim objDictionary As Object
Sub CountSentMailsByMonth()
Dim objOutlookFile As Outlook.Folder
Dim objFolder As Outlook.Folder
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
Dim varMonths As Variant
Dim varItemCounts As Variant
Dim nLastRow As Integer
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
'Get the default Outlook data file
Set objOutlookFile = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent
For Each objFolder In objOutlookFile.Folders
If objFolder.DefaultItemType = olMailItem Then
Call ProcessFolders(objFolder)
End If
Next
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = True
Set objExcelWorkbook = objExcelApp.Workbooks.Add
Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
With objExcelWorksheet
.Cells(1, 1) = "Month"
.Cells(1, 2) = "Count"
End With
varMonths = objDictionary.Keys
varItemCounts = objDictionary.Items
For i = LBound(varMonths) To UBound(varMonths)
nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
With objExcelWorksheet
.Cells(nLastRow, 1) = varMonths(i)
.Cells(nLastRow, 2) = varItemCounts(i)
End With
Next
objExcelWorksheet.Columns("A:B").AutoFit
End Sub
Sub ProcessFolders(ByVal objCurFolder As Outlook.Folder)
Dim i As Long
Dim objMail As Outlook.MailItem
Dim strMonth As String
For i = objCurFolder.Items.Count To 1 Step -1
If objCurFolder.Items(i).Class = olMail Then
Set objMail = objCurFolder.Items(i)
'Change to your own email address
If objMail.SenderEmailAddress = "you@datanumen.com" Then
strMonth = Format(Year(objMail.SentOn) & "-" & Month(objMail.SentOn), "YYYY/MM")
If objDictionary.Exists(strMonth) Then
objDictionary(strMonth) = objDictionary(strMonth) + 1
Else
objDictionary.Add strMonth, 1
End If
End If
End If
Next
End Sub
- Next, move cursor into the first subroutine.
- Subsequently, press “F5” to trigger this macro.
- At once, an Excel file will show up, which contains the counts of sent emails in every month, as shown in the figure below.
Don’t Panic in Face of Outlook Corruption
You may tend to be worried when encountering PST damage. Yet, in reality, you’d better calm down as soon as possible. As we all know, panic is helpless and even leading to more chaotic and serious problems. You should keep calm to consider measures, such as thinking over whether you have updated backup and consider how to repair PST – whether to resort to third party tool like DataNumen Outlook Repair or contact relevant professionals.
Author Introduction:
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair mdf and outlook repair software products. For more information visit www.datanumen.com

