Wenn Sie einen neuen Kontakt erstellen und das Datum für den Geburtstag eintragen, dann erstellt Outlook automatisch einen Serientermin für den Geburtstag im Kalender. Wenn diese Geburtstag aus irgendwelchen Gründen aus dem Kalender verschwinden, dann müÃten Sie alle Kontakte von Hand nachbearbeiten. Dieses Makro nimmt die Arbeit ab und sorgt dafür, dass alle Geburtstage eines auszuwählenden Kontakteordners wieder in den Kalender eingetragen werden.
Public Sub AddBirthdays()
Dim Folder As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim obj As Object
Dim Contact As Outlook.ContactItem
Dim BDay As Date
Set Folder = Application.Session.PickFolder
If Folder Is Nothing Then Exit Sub
If Folder.DefaultItemType = olContactItem Then
Dim i As Integer
Set Items = Folder.Items
For Each obj In Items
If TypeOf obj Is Outlook.ContactItem Then
Set Contact = obj
BDay = Contact.Birthday
If Year(BDay) > 0 And Year(BDay) < 4000 Then
Contact.Birthday = 0
Contact.Save
Contact.Birthday = BDay
Contact.Save
End If
End If
Next
End If
MsgBox "fertig"
End Sub