VBA – Outlook: Abwesenheit für Feiertage (NRW) setzen

Beschreibung

Outlook bietet von Haus aus an, Feiertage zu importieren. Es werden dabei alle Feiertage des gewählten Landes importiert und mit der Kategorie „Feiertag“ versehen. Da bei mir in NRW nicht an allen deutschen Feiertagen frei ist,  können diese getrost aus der Kategorie „Feiertag“ entfernt werden. Da ich an den übrigen Feiertagen allerdings in der Regel nicht im Büro bin, können diese auch auf „abwesend“ gesetzt werden.

Das Entfernen der Kategorie geht von Hand relativ schnell. Die anderen Tage auf „abwesend“ zu setzen ist hingegen von Hand eher eine Fleißarbeit. Das folgende Outlook VBA-Makro übernimmt diese Aufgabe und kann auch leicht an andere Bundesländer angepasst werden.

Hinweis: Das Importieren der Feiertage in Outlook 2010 erfolgt über Datei – Optionen – Kalender und dort unter Kalenderoptionen über die Schaltfläche Feiertage hinzufügen.

Sourcecode

Sub setFeiertageAbwesend()
    ' Die Anwendung erfolgt im gerade selektierten Kalender
    Dim olFolder As MAPIFolder
    Set olFolder = Application.ActiveExplorer.CurrentFolder

    ' Ist kein Kalender selektiert, wird die Operation übersprungen
    If olFolder.DefaultItemType = olAppointmentItem Then
        Dim olApptItem As Outlook.AppointmentItem

        For Each olApptItem In olFolder.Items
            With olApptItem
                ' Nur Termine der Kategorie "Feiertag" bearbeiten
                If InStr(.Categories, "Feiertag") Then
                    ' Nur Termine die als "frei" angezeigt werden bearbeiten
                    If .BusyStatus = olFree Then
                        ' Nur NRW-Feiertage als "Abwesend" markieren
                        If InStr(.ConversationTopic, "Heilige Drei Könige") = 0 And _
                           InStr(.ConversationTopic, "Mariä Himmelfahrt") = 0 And _
                           InStr(.ConversationTopic, "Buß- und Bettag") = 0 And _
                           InStr(.ConversationTopic, "Reformationstag") = 0 Then
                            .BusyStatus = olOutOfOffice
                            .Save
                        Else
                            ' Nicht NRW-Feiertage aus der Kategorie "Feiertag" entfernen
                            .Categories = Replace(.Categories, "Feiertag", "")
                            .Save
                        End If
                    End If
                End If
            End With
        Next olApptItem
    End If
End Sub