Populating Birthday From Contacts

by jasonstrate, posted in Microsoft Office, Outlook

This is completely off topic and has everything to do with Outlook and my calendar.  While traveling something happened to my contact and calendar synchronization and I ended up with 4 or 5 birthdays for all of my contacts.  Some were on a single day and others started and ended 2-hours early – most likely the consequence of traveling to the west coast.

Anyway I deleted all of the birthdays on my calendar last weekend and wanted to re-populate them.  Unfortunately there isn’t anything automated that will do this.  So I found a Microsoft article on Programatically Change the Display Format for All Contacts and modified it to fit my needs.

The code below is what I am using to do this:

Private Sub UpdateBirthday()
    Dim items As items, item As ContactItem, folder As folder

    Dim contactItems As Outlook.items
    Dim itemContact As Outlook.ContactItem

    Set folder = Session.GetDefaultFolder(olFolderContacts)
    Set items = folder.items
    Count = items.Count

    If Count = 0 Then
        MsgBox "Nothing to do!"
        Exit Sub
    End If

    'Filter on the message class to obtain only contact items in the folder
    Set contactItems = items.Restrict("[MessageClass]='IPM.Contact'")

    For Each itemContact In contactItems
        If Not itemContact.Birthday = #1/1/4501# Then
            itemContact.Birthday = itemContact.Birthday
            itemContact.Save
       End If
    Next

    MsgBox "Your calendar has been updated."
End Sub

I am primarily posting this because all of the searches I did all pointed to software that could be purchased to do this and that seemed a bit overboard to me.  Just add this to a macro in your Outlook session and it works like a champ.