here is a function that should do the job:
Folder "OL2002" -> Item 36 on http://www.DocOutlook.de/
-- 
Viele Grüße
Michael Bauer
"Jaded in Cali" <Jaded in Ca...@discussions.microsoft.com> wrote in
message news:6595D29E-9AEC-465A...@microsoft.com...
1.  My VBA editor opens with Option Explicit, so I had to Dim i and 
mybirthday.
2.  The date is in European format: xx.xx.xxxx, which Outlook did not 
recognize.  I changed it to xx/xx/xxxx, which worked fine.
Thanks again.
--j
-- 
Viele Grüße
Michael Bauer
"Jaded in Cali" <Jaded in Ca...@discussions.microsoft.com> wrote in
message news:8CF4C806-AA6F-4780...@microsoft.com...
http://www.outlook-stuff.com/component/option,com_docman/task,doc_details/gid,26/Itemid,2/
Peter
--
Infos, workshops & software for
Outlook®: www.outlook-stuff.com
Sub CreateBirthdays()
    Dim objContacts As Outlook.Items
    Dim objContact As Outlook.ContactItem
    Dim objAppointment As Outlook.AppointmentItem
    Dim objCalendar As Outlook.MAPIFolder
    Dim objRecPattern As Outlook.RecurrencePattern
    Dim colLinks As Outlook.Links
    If
InStr(UCase(Outlook.ActiveExplorer.CurrentFolder.DefaultMessageClass),
"IPM.CONTACT") = 0 Then
        MsgBox "Please select a contact folder.", vbCritical +
vbOKOnly
        Exit Sub
    End If
    Set objCalendar =
Outlook.Session.GetDefaultFolder(olFolderCalendar)
    Set objContacts = Outlook.ActiveExplorer.CurrentFolder.Items
For Each objContact In objContacts
        If Year(objContact.Birthday) <> 4501 Then
            Set objAppointment = objCalendar.Items.Add
            Set colLinks = objAppointment.Links
            With objAppointment
                .Subject = Trim(objContact.FirstName & " " & _
                    objContact.LastName) & "'s Birthday"
                .Start = objContact.Birthday
                .AllDayEvent = True
                Call colLinks.Add(objContact)
                Set objRecPattern = .GetRecurrencePattern
                objRecPattern.RecurrenceType = olRecursYearly
                objRecPattern.PatternStartDate = objContact.Birthday
                .Save
            End With
        End If
        Set colLinks = Nothing
        Set objContact = Nothing
        Set objAppointment = Nothing
        Set objRecPattern = Nothing
Next
End Sub
Can occour an error if you use an exchange server without cache mode.
If so simply press F5 to continue. If you break the code you have to
delete all created items in the calendar before start it again,
because the code does not check if the item exists.
I think the tool is the better way but now you have the choise.
Peter
Sub CreateBirthdays()
    Dim objContacts As Outlook.Items
    Dim objItem As Object
    Dim objAppointment As Outlook.AppointmentItem
    Dim objCalendar As Outlook.MAPIFolder
    Dim objFolder As Outlook.MAPIFolder
    Dim objRec As Outlook.RecurrencePattern
    Dim colLinks As Outlook.Links
    Set objFolder = Outlook.ActiveExplorer.CurrentFolder
    If InStr(UCase(objFolder.DefaultMessageClass), _
        "IPM.CONTACT") = 0 Then
        MsgBox "Please select a contact folder.", 16
        Exit Sub
    End If
    Set objCalendar = _
        Outlook.Session.GetDefaultFolder(olFolderCalendar)
    Set objContacts = _
        Outlook.ActiveExplorer.CurrentFolder.Items
For Each objItem In objContacts
If objItem.Class <> olContact Then GoTo Skippy
If Year(objItem.Birthday) <> 4501 Then
            Set objAppointment = objCalendar.Items.Add
            Set colLinks = objAppointment.Links
            With objAppointment
                .Subject = Trim(objItem.FirstName & " " & _
                    objItem.LastName) & "'s Birthday"
                .Start = objItem.Birthday
                .AllDayEvent = True
                Call colLinks.Add(objItem)
                Set objRec = .GetRecurrencePattern
                objRec.RecurrenceType = olRecursYearly
                objRec.PatternStartDate = objItem.Birthday
                .Save
            End With
        End If
Skippy:
        Set colLinks = Nothing
        Set objItem = Nothing
        Set objAppointment = Nothing
        Set objRec = Nothing
Next
    Set objFolder = Nothing
    Set objCalendar = Nothing
End Sub
Peter
> > ck- Zitierten Text ausblenden -
>
> - Zitierten Text anzeigen -
 Where do I go to add this code so the birthdays automatically display in my 
contacts?  And, are they recurring each year on that date?  If not, is there 
code to make them recurring?  Since I don't have access to my bosses' contact 
list, I guess the only way to get them on my bosses' calendar, is to drag 
them over, unless you have a faster way of doing this.  Also, if there are 
old entries, can it compare to see if they are currently on the new list, and 
if not, delete that reocurring entry?
Anything you do to help me automate this task would be greatly appreciated.
Susan