Public Sub GBAlterBerechnen()
Dim kalender As Outlook.folder
Dim termin As Outlook.AppointmentItem
Set kalender = Application.Session.GetDefaultFolder(olFolderCalendar)
'Alle Termine durchlaufen die der Kategorie "Geburtstag" angehören und Serientermine sind
For Each termin In kalender.Items
If Not InStr(termin.Categories, "Geburtstag") = 0 And Not InStr(termin.Subject, "GB") = 0 And termin.IsRecurring Then
'Falls Start des Serientermins nicht kleiner als 2000 ist, wird davon ausgegangen, dass dies ein Fehler ist
If Not Year(termin.GetRecurrencePattern.PatternStartDate) > 2000 Then
termin.Location = "[Berechnet] Wird dieses Jahr (" & CStr(Year(Now)) & ") " & _
CStr(Year(Now) - Year(termin.GetRecurrencePattern.PatternStartDate)) & " Jahre alt"
Else
termin.Location = "Fehler beim Berechnen des Alters! Startdatum für Serie nicht korrekt."
End If
termin.Body = "Alter via Makro berechnet am: " & CStr(Now)
'Erinnerung (Default: 12 Stunden)
termin.ReminderSet = True
termin.ReminderOverrideDefault = True
termin.ReminderMinutesBeforeStart = 12 * 60
'Busy Status auf "Frei" setzen
termin.Sensitivity = olNormal
termin.Save
End If
Next
End Sub
(Kein individueller Support.)