betrifft MS Outlook

Problembeschreibung:

Die Feiertage in Outlook werden nur mit dem Service-Packs ausgeliefert. Wenn z.B. nur SP2 installiert ist, sind die Feiertage nur für 2007 oder 2008 verfügbar. Die Feiertage, obwohl es entweder feste Tage oder feste Regeln für diese Tage gibt, können von Outlook bis heute nicht im Voraus berechnet werden.

Lösungsidee

Die Berechnung der Feiertage erfolgt über VBA nach einer Berechnungsformel, die auf der Gaußchen Osterregel basiert. Dazu werden die festen Feiertage direkt gesetzt und die variablen Feiertage abhängig vom Ostersonntag berechnet. Die Feiertage werden als Ganztags-Termine in Outlook eingestellt und mit dem Titel des Tages benannt.

Die Konfiguration der Feiertage und für welche Jahre diese eingestellt werden sollen, wird im oberen Teil der Funktion definiert. Die Prozedur löscht auch bereits definierte Feiertage, damit bei mehrmaligem Aufruf keine doppelten Termine entstehen.

Programmcode

Sub Feiertage_DE_einstellen()
  'stellt die Feiertage als ganztägige Termine ein, keine Erinnerung, Termin wird als belegt markiert, Kategorie Feiertag
  
  Const VON_JAHR As Long = 2010     ''Jahr, ab dem die Feiertage eingestellt werden sollen
  Const BIS_JAHR As Long = 2011     ''Jahr, bis (einschließlich) die Feiertage eingestellt werden sollen
  
  Dim FESTE_FEIERTAGE As Variant    ''feste Feiertage definieren
  FESTE_FEIERTAGE = Array( _
            "01.01.", "Neujahr", _
            "06.01.", "Heilige 3 Könige (BW,BY,ST)", _
            "01.05.", "Maifeiertag", _
            "15.08.", "Maria Himmelfahrt (BY,SL)", _
            "03.10.", "Tag der deutschen Einheit", _
            "31.10.", "Reformationstag (BB,MV,SA,ST,TH)", _
            "01.11.", "Allerheiligen (BW,BY,NW,RP,SL)", _
            "25.12.", "1. Weihnachtsfeiertag", _
            "26.12.", "2. Weihnachtsfeiertag" _
  )
  
  Dim VARIABLE_FEIERTAGE As Variant ''variable Feiertage definieren (Tage nach Ostersonntag, Name des Feiertags)
  VARIABLE_FEIERTAGE = Array( _
            -2, "Karfreitag", _
            0, "Ostersonntag", _
            1, "Ostermontag", _
            39, "Christi Himmelfahrt", _
            50, "Pfingstmontag", _
            60, "Fronleichnam (BW,BY,HE,NW,RP,SL,SA,TH)" _
  )

  
  'weitere Variablen
  Dim Namensraum As NameSpace       'Namensraum
  Dim Kalender As MAPIFolder        'Ordner "Kalender"
  Dim Termin As AppointmentItem     'Kalenderobjekt
  Dim Jahr As Long                  'Jahr
  Dim FT_geloescht As Long          'gelöschte Feiertage
  Dim FT_angelegt As Long           'angelegte Feiertage
  Dim Anzahl_FT As Long             'Anzahl der definierten Feiertage
  Dim Datum_Ostersonntag As Date    'Datum von Ostersonntag
  Dim i As Long                     'Hilfsvariable
  
  Set Namensraum = GetNamespace("MAPI")
  Set Kalender = Namensraum.GetDefaultFolder(olFolderCalendar)
    
  '1. alle Feiertage in diesem Zeitraum löschen
  FT_geloescht = 0
  For Jahr = VON_JAHR To BIS_JAHR
    For Each Termin In Kalender.Items
      'ist ein Feiertag?
      If Termin.AllDayEvent = True And Termin.Categories Like "*Feiertag*" And Year(Termin.Start) = Jahr Then
        'ja es ist ein ganztägiger Feiertag -> löschen
        Termin.Delete
        FT_geloescht = FT_geloescht + 1
      End If
      'nächster Kalendereintrag
    Next Termin
    'nächstes Jahr
  Next Jahr
  
  'Feiertage anlegen
  FT_angelegt = 0
  '2. feste Feiertage anlegen
  Anzahl_FT = (UBound(FESTE_FEIERTAGE) + 1) / 2
  For Jahr = VON_JAHR To BIS_JAHR
    i = 0
    While i <= UBound(FESTE_FEIERTAGE)
      Set Termin = CreateItem(olAppointmentItem)
      Termin.Subject = FESTE_FEIERTAGE(i + 1)       'Titel des Feiertags
      Termin.Start = FESTE_FEIERTAGE(i) & Jahr      'Datum des Feiertags
      Termin.AllDayEvent = True                     'ganztägiges Ereignis
      Termin.Categories = "Feiertag"                'Kategorie: Feiertag
      Termin.ReminderSet = False                    'keine Erinnerung
      Termin.BusyStatus = olBusy                    'als Belegt kennzeichnen
      Termin.Save                                   'Termin speichern
      FT_angelegt = FT_angelegt + 1
      Set Termin = Nothing
      'nächster Feiertag
      i = i + 2
    Wend
    'nächstes Jahr
  Next Jahr
  
  'Nun varaiable Feiertage berechnen
  Anzahl_FT = (UBound(VARIABLE_FEIERTAGE) + 1) / 2
  For Jahr = VON_JAHR To BIS_JAHR
    '3. Zuerst Ostersonntag ermitteln
    Datum_Ostersonntag = Ostersonntag(Jahr)
    
    'Datum der Feiertage ermitteln
    i = 0
    While i <= UBound(VARIABLE_FEIERTAGE)
      Set Termin = CreateItem(olAppointmentItem)
      Termin.Subject = VARIABLE_FEIERTAGE(i + 1)       'Titel des Feiertags
      Termin.Start = DateAdd("d", VARIABLE_FEIERTAGE(i), Datum_Ostersonntag)      'Datum des Feiertags
      Termin.AllDayEvent = True                     'ganztägiges Ereignis
      Termin.Categories = "Feiertag"                'Kategorie: Feiertag
      Termin.ReminderSet = False                    'keine Erinnerung
      Termin.BusyStatus = olBusy                    'als Belegt kennzeichnen
      Termin.Save                                   'Termin speichern
      FT_angelegt = FT_angelegt + 1
      Set Termin = Nothing
      'nächster Feiertag
      i = i + 2
    Wend
    'nächstes Jahr
  Next Jahr
    
  'Fertig
  Set Kalender = Nothing
  Set Namensraum = Nothing
  MsgBox "Fertig. " & FT_angelegt & " Feiertage angelegt, " & FT_geloescht & " Feiertage gelöscht.", vbOKOnly + vbInformation
End Sub

Function Ostersonntag(ByVal Jahr As Long) As Date
  ' Osterfunktion nach Carl Friedrich Gauß (1800). Rückgabewert
  ' ist das Datum des Ostersonntags im angegebenen Jahr.
  ' Gültigkeitsbereich: 1583 - 8702
  Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
    
  ' Die "magische" Gauss-Formel anwenden:
  a = Jahr Mod 19
  b = Jahr \\ 100
  c = (8 * b + 13) \\ 25 - 2
  d = b - (Jahr \\ 400) - 2
  e = (19 * (Jahr Mod 19) + ((15 - c + d) Mod 30)) Mod 30
  If e = 28 Then
    If a > 10 Then
      e = 27
    End If
  ElseIf e = 29 Then
    e = 28
  End If
  f = (d + 6 * e + 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) + 6) Mod 7
  
  ' Rückgabewert als Datum bereitstellen
  Ostersonntag = DateSerial(Jahr, 3, e + f + 22)
End Function