Outlook Alter Anzeigen

Sub AlterAnzeigen()

 Dim myNameSpace As NameSpace

 Dim Alter As String
 Dim Zaehler
 Dim GebJahr

 Set myolApp = CreateObject("Outlook.Application")
 Set myNameSpace = myolApp.GetNamespace("MAPI")
 Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
 Set myitems = myFolder.Items

 Zaehler = 0

 'Suche nach dem Begriff "Geburtstag von" in allen Kalendereinträgen
 For i = myitems.Count To 1 Step -1
     'Prüfung der Kalendereinträge auf den Text "Geburtstag von"
     'und Überprüfung ob es sich um ein ganztägiges Ereignis handelt
     If InStr(myitems(i).Subject, "Geburtstag von") And myitems(i).AllDayEvent = True Then
         myitems(i).Display
         GebJahr = myitems(i).GetRecurrencePattern.PatternStartDate
         Alter = DateDiff("yyyy", GebJahr, Now()) 'Hier wird das Alter errechnet
         myitems(i).Location = "[Alter: " + Alter + "]"
         myitems(i).Save
         myitems(i).Close 0
         Zaehler = Zaehler + 1 'Zähler für die Anzahl der geänderten Einträge
     End If
 Next

 MsgBox "Fertig!" & vbCrLf & Zaehler & " Geburtstagseinträge geändert.", vbInformation, "Geburtstage angepasst "
 End Sub