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 = "firstname.lastname@example.org" 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.
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