How to Quickly Count Contacts by Year of Birth in Your Outlook

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

1. At first, trigger Outlook VBA editor via “Alt + F11”.
2. 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“.
3. 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

4. Next, click into the first subroutine.
5. Finally, press “F5” key button.
6. 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.

Author Introduction:

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