Perhaps you have added birthday information to multiple contacts in your Outlook. Now, if you would like to count the contacts by year of birth, it isn’t a good idea to do it manually. You’d better use a smarter way, such as the one shared in this post.
After adding or importing the birthdays to corresponding Outlook contacts, you may wish to get some statistics about the birthday information, such as counting contacts by year of birth. Obviously, manually counting is stupid. So, here we will introduce another intelligent method. Now read on to get the details.
Quickly Count Contacts by Year of Birth
- At first, trigger Outlook VBA editor via “Alt + F11”.
- In the subsequent “Microsoft Visual Basic for Applications” window, add the reference to “MS Excel Object Library” according to “How to Add an Object Library Reference in VBA“.
- Then, put the following VBA code into a module or project.
Dim objDictionary As Object Sub CountContactsByYearOfBirth () 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 varYears As Variant Dim varItemCounts As Variant Dim nLastRow As Integer Set objDictionary = CreateObject("Scripting.Dictionary") 'Get the default Outlook data file Set objOutlookFile = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Parent For Each objFolder In objOutlookFile.Folders If objFolder.DefaultItemType = olContactItem Then Call ProcessFolders(objFolder) End If Next 'Export the counts to Excel Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = True Set objExcelWorkbook = objExcelApp.Workbooks.Add Set objExcelWorksheet = objExcelWorkbook.Sheets(1) With objExcelWorksheet .Cells(1, 1) = "Year" .Cells(1, 1).Font.Bold = True .Cells(1, 2) = "Count" .Cells(1, 2).Font.Bold = True End With varYears = objDictionary.Keys varItemCounts = objDictionary.Items For i = LBound(varYears) To UBound(varYears) nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1 With objExcelWorksheet .Cells(nLastRow, 1) = varYears(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 objContact As Outlook.ContactItem Dim strYear As String For i = objCurFolder.Items.Count To 1 Step -1 If TypeOf objCurFolder.Items(i) Is ContactItem Then Set objContact = objCurFolder.Items(i) 'If the contact has birthday If objContact.Birthday <> #1/1/4501# Then strYear = Year(objContact.Birthday) If objDictionary.Exists(strYear) Then objDictionary(strYear) = objDictionary(strYear) + 1 Else objDictionary.Add strYear, 1 End If End If End If Next End Sub
- Next, click into the first subroutine.
- Finally, press “F5” key button.
- When macro finishes, you will get a new Excel worksheet. It contains the counts of birthdays in different years, as shown in the following figure.
Get Back Valuable Outlook Data
Many users have been plagued by Outlook data corruption. Hence, it is suggested to make regular data backups for your Outlook, such that you can easily recover Outlook data from backups even though PST file is corrupt. If you have no such backups, you can take aid of a proficient recovery tool, like DataNumen Outlook Repair.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including mdf fix and outlook repair software products. For more information visit www.datanumen.com