Hallo zusammen

Ich versuche mich jetzt schon paar mal, aufgrund eines Kalendereintrages soll eine automatische Antwort eingestellt werden. Sprich, das Script soll 5 Tage in die Zukunft blicken und wenn er einen Eintrag findet, welcher die Kategorie "Frei" einthält, soll er für diese Start und Enddatum entnehmen und diese für die Autoantwort einstellen, dies auch im Text hinterlegen.

Was ich aber feststellen muss ist wohl, dass man dies über VBA gar nicht ansteuern kann. Kann das sein?

Private Sub Application_Startup()
    Call SetOutOfOfficeBasedOnCalendar
End Sub

Sub SetOutOfOfficeBasedOnCalendar()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olAppt As Outlook.AppointmentItem
    Dim i As Integer
    Dim outOfOfficeStart As Date
    Dim outOfOfficeEnd As Date
    Dim subject As String
    Dim autoReplyMessage As String

    ' Initialize Outlook objects
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderCalendar)
    Set olItems = olFolder.Items

    ' Filter items within the next 5 days
    olItems.Sort "[Start]", True
    olItems.IncludeRecurrences = True

    ' Set filter for appointments in the next 5 days with category "Freie Tage (Ferien)"
    Dim filter As String
    filter = "[Start] <= '" & Format(Date + 5, "ddddd h:nn AMPM") & "' AND [End] >= '" & Format(Date, "ddddd h:nn AMPM") & "' AND [Categories] = 'Freie Tage (Ferien)'"

    Dim olFilteredItems As Outlook.Items
    Set olFilteredItems = olItems.Restrict(filter)

    If olFilteredItems.count > 0 Then
        ' Assume the first item that matches the criteria is the one we want
        Set olAppt = olFilteredItems.GetFirst

        outOfOfficeStart = olAppt.Start
        outOfOfficeEnd = olAppt.End

        ' Construct the automatic reply message
        subject = "Abwesend: " & olAppt.subject
        autoReplyMessage = "Ich bin vom " & Format(outOfOfficeStart, "dddd, mmmm dd, yyyy h:nn AM/PM") & " zum " & Format(outOfOfficeEnd, "dddd, mmmm dd, yyyy h:nn AM/PM") & " abwesend. Ihre E-Mail wird nicht bearbeitet."

        ' Set up the automatic replies (Out of Office)
        SetAutomaticReplies outOfOfficeStart, outOfOfficeEnd, autoReplyMessage
    Else
        MsgBox "No 'Freie Tage (Ferien)' entries found in the next 5 days.", vbInformation
    End If

    ' Clean up
    Set olAppt = Nothing
    Set olFilteredItems = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub

Sub SetAutomaticReplies(startDate As Date, endDate As Date, replyMessage As String)
    Dim oSession As Object
    Dim oAccount As Object
    Dim oAutoReply As Object

    ' Create an instance of the Outlook session
    Set oSession = CreateObject("Outlook.Application").Session
    Set oAccount = oSession.Accounts.Item(1) ' Assumes the first account is the one to set OOF for

    ' Create an instance of the AutoReply object
    Set oAutoReply = oAccount.AutoReply '=> Das hier scheint es wohl gar nicht zu gebe.?

    ' Set up the auto-reply properties
    With oAutoReply
        .StartTime = startDate
        .EndTime = endDate
        .InternalReplyMessage = replyMessage
        .ExternalReplyMessage = replyMessage
        .Enabled = True
    End With

    ' Save the auto-reply settings
    oAutoReply.Save

    ' Clean up
    Set oAutoReply = Nothing
    Set oAccount = Nothing
    Set oSession = Nothing
End Sub

Kann mir jemand auf die Sprünge helfen? Vielen Dank im Vorraus.