Zuletzt aktualisiert am 31. Dezember 2017
Aus Abschnitt Microsoft Office Macros und markiert mit

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

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.