Geburtstage (Alter) berechnen (Outlook Makro)

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