Populating Birthday From Contacts

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.

No related posts.

Leave a Reply