Public Sub TodestagJaehrungBerechnen()
Dim kalender As Outlook.Folder
Dim termin As Outlook.AppointmentItem
Set kalender = Application.Session.GetDefaultFolder(olFolderCalendar)
'Alle Termine durchlaufen die der Kategorie "Todestag" angehören und Serientermine sind
For Each termin In kalender.Items
If Not InStr(termin.Categories, "Todestag") = 0 And Not InStr(termin.Subject, "Todestag") = 0 And termin.IsRecurring Then
termin.Location = "[Berechnet] Jährt sich dieses Jahr (" + CStr(Year(Now)) + ") zum " + CStr(Year(Now) - Year(termin.GetRecurrencePattern.PatternStartDate)) & ". mal"
termin.Body = "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.)