Click here to Skip to main content
13,085,613 members (89,775 online)
Click here to Skip to main content
Add your own
alternative version

Tagged as


2 bookmarked
Posted 15 Nov 2010

Insert Outlook Contact Birthdays in Calendar

, 15 Nov 2010
Rate this:
Please Sign up or sign in to vote.
This macro can be inserted in Outlook 2000 to search all your contacts for birthday information. If the birthday does not appear in the calendar, then insert it. The macro will dump a small text file "c:\Outlook.log" that lists the activity.

Open your Outlook, goto Tools -> Macro -> Visual Basic Editor

Do a right-button on ThisOutlookSession and insert a module.

Paste the code below, and run.

Sub FindBirthdays()
    Dim Person As Variant
    Dim Bday As Variant
    Dim NewBday As Outlook.AppointmentItem
    Dim NewPatt As Outlook.RecurrencePattern
    LogFile = "c:\Outlook.log"
    fnum = FreeFile()
    Open LogFile For Output As fnum
    Print #fnum, "Outlook Birthday Export"
    Set olns = ThisOutlookSession.Application.GetNamespace("MAPI")
    Set ContactFolder = olns.GetDefaultFolder(olFolderContacts)
    Set CalendarFolder = olns.GetDefaultFolder(olFolderCalendar)
    Set MyContacts = ContactFolder.Items
    Set MyBirthdays = CalendarFolder.Items
    For Each Person In MyContacts
        If Person.Class = olContact Then
            If Year(Person.Birthday) < 4000 Then
                ' check if this birthday is on my calendar
                foundBirthday = False
                For Each Bday In MyBirthdays
                   If Bday.Class = olAppointment Then
                       If InStr(Bday.Subject, "Birthday") > 0 And _
                            Left(Bday.Subject, 5) = Left(Person.FullName, 5) Then
                        foundBirthday = True
                       End If
                   End If
                Next Bday
                If foundBirthday Then
                    Print #fnum, Person.FullName; Tab(30); _
                     Format(Person.Birthday, "dd-mmm-yyyy")
                    Set NewBday = Outlook.CreateItem(olAppointmentItem)
                    Set NewPatt = NewBday.GetRecurrencePattern
                    NewPatt.RecurrenceType = olRecursYearly
                    NewPatt.PatternStartDate = Person.Birthday
                    NewPatt.DayOfMonth = Day(Person.Birthday)
                    NewPatt.MonthOfYear = Month(Person.Birthday)
                    NewPatt.NoEndDate = True
                    NewBday.MeetingStatus = olNonMeeting
                    NewBday.Subject = Person.FullName & "'s Birthday"
                    NewBday.Start = Person.Birthday
                    NewBday.AllDayEvent = True
                    NewBday.BusyStatus = olFree
                    Print #fnum, Person.FullName; Tab(30); _
                     Format(Person.Birthday, "dd-mmm-yyyy"); _
                     Tab(50); "Added to calendar"
                End If
            End If
        End If
    Next Person
    Close #fnum
End Sub


This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


About the Author

Systems Engineer
United States United States
This member doesn't quite have enough reputation to be able to display their biography and homepage.

You may also be interested in...

Comments and Discussions

GeneralMy vote of 5 Pin
Sridhar Kadali28-Jun-12 0:00
memberSridhar Kadali28-Jun-12 0:00 
GeneralReason for my vote of 5 Very useful tip Pin
Siedlerchr23-Nov-10 22:36
memberSiedlerchr23-Nov-10 22:36 
GeneralThx! Pin
Siedlerchr23-Nov-10 22:36
memberSiedlerchr23-Nov-10 22:36 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Permalink | Advertise | Privacy | Terms of Use | Mobile
Web04 | 2.8.170813.1 | Last Updated 15 Nov 2010
Article Copyright 2010 by Edzko
Everything else Copyright © CodeProject, 1999-2017
Layout: fixed | fluid