In unserem täglichen Arbeitsleben ist es oft eine Herausforderung, den Überblick über wichtige Termine wie Geburtstage unserer Kontakte zu behalten. Microsoft Outlook bietet zwar die Möglichkeit, Geburtstage direkt aus den Kontaktdaten in den Kalender einzutragen, jedoch kann es vorkommen, dass diese Einträge aus verschiedenen Gründen aus dem Kalender verschwinden oder gar nicht erst automatisch hinzugefügt werden.
Dieses Makro ist eine effiziente Lösung, um Geburtstage aus allen Kontakten in Ihrem Outlook-Kontakteordner automatisch in Ihren Kalender einzutragen. Es erspart Ihnen nicht nur Zeit, indem es die manuelle Eingabe jedes Geburtstags vermeidet, sondern stellt auch sicher, dass Sie keinen wichtigen Geburtstag vergessen. Im Folgenden finden Sie eine Schritt-für-Schritt-Anleitung und den benötigten VBA-Code, um dieses hilfreiche Werkzeug in Ihrem Outlook einzurichten.
Schritt 1: Öffnen Sie Outlook und drücken Sie Alt + F11, um den VBA-Editor zu öffnen.
Schritt 2: Gehen Sie zu Einfügen > Modul, um ein neues Modul zu erstellen.
Schritt 3: Kopieren Sie den folgenden Code in das Modul:
Sub AddBirthdaysToCalendar()
Dim ContactsFolder As Folder
Dim ContactItem As Object
Dim CalendarFolder As Folder
Dim AppointmentItem As AppointmentItem
Dim Birthday As Date
Dim ItemExists As Boolean
' Setzen Sie den Pfad zu Ihrem Kontakteordner
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
' Zugriff auf den Kalender
Set CalendarFolder = Session.GetDefaultFolder(olFolderCalendar)
' Durchlaufen aller Kontakte
For Each ContactItem In ContactsFolder.Items
If TypeName(ContactItem) = "ContactItem" Then
If ContactItem.Birthday <> "01.01.4501" Then
Birthday = ContactItem.Birthday
ItemExists = False
' Überprüfen, ob der Termin bereits existiert
For Each AppointmentItem In CalendarFolder.Items
If AppointmentItem.Subject = ContactItem.FullName & "'s Birthday" And _
AppointmentItem.Start = DateSerial(Year(Birthday), Month(Birthday), Day(Birthday)) Then
ItemExists = True
Exit For
End If
Next AppointmentItem
' Termin hinzufügen, falls nicht vorhanden
If Not ItemExists Then
Set AppointmentItem = CalendarFolder.Items.Add(olAppointmentItem)
With AppointmentItem
.Subject = ContactItem.FullName & "'s Birthday"
.Start = DateSerial(Year(Birthday), Month(Birthday), Day(Birthday))
.AllDayEvent = True
.Categories = "Birthday"
.Save
End With
End If
End If
End If
Next ContactItem
MsgBox "Geburtstage wurden zum Kalender hinzugefügt."
End Sub
Schritt 4: Speichern Sie den Code und schließen Sie den VBA-Editor.
Schritt 5: Führen Sie das Makro aus, indem Sie zurück zu Outlook gehen, Alt + F8 drücken, das Makro AddBirthdaysToCalendar auswählen und auf Ausführen klicken.
Dieses Skript durchläuft alle Kontakte in Ihrem Standard-Kontakteordner und überprüft, ob für jeden Kontakt ein Geburtstag eingetragen ist. Wenn ja, prüft es, ob bereits ein entsprechender Termin im Kalender vorhanden ist. Ist dies nicht der Fall, wird ein neuer ganztägiger Termin für den Geburtstag erstellt.