Dim objDictionary As Object Sub CountSentMailsByMonth() 'Must enable Microsoft Excel Reference Library Dim objOutlookFile As Outlook.Folder Dim objFolder As Outlook.Folder Dim objExcelApp As Excel.Aapplication 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
Preview:
downloadDownload PNG
downloadDownload JPEG
downloadDownload SVG
Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!
Click to optimize width for Twitter