Option Explicit

Dim delayMinutes
delayMinutes = 90   ' Verzögerung in Minuten (z.B. 90 für 1,5h)
'delayMinutes = 1   ' Verzögerung in Minuten (z.B. 90 für 1,5h)


' Prüfen, ob das Skript bereits vom Taskplaner mit dem Parameter /send gestartet wurde
If WScript.Arguments.Count > 0 Then
    If WScript.Arguments(0) = "/send" Then
        Call SendKuchenTermin()
        WScript.Quit
    End If
End If

' -------------------------------------------------------------
' 1. AUFRUF: Task für später einplanen und sofort beenden
' -------------------------------------------------------------
Dim runTime, runTimeStr, wsh, cmd, taskName

' Uhrzeit in X Minuten berechnen (Format HH:MM:SS)
runTime = DateAdd("n", delayMinutes, Now)
runTimeStr = Right("0" & Hour(runTime), 2) & ":" & _
             Right("0" & Minute(runTime), 2) & ":" & _
             Right("0" & Second(runTime), 2)

taskName = "KuchenTermin_" & Year(Now) & Month(Now) & Day(Now) & "_" & Hour(Now) & Minute(Now) & Second(Now)

' Einmaligen Task erstellen, der sich nach Ausführung löscht
cmd = "schtasks /create /tn """ & taskName & """ /tr ""wscript.exe \""" & WScript.ScriptFullName & "\"" /send"" /sc ONCE /st " & runTimeStr & " /f"

Set wsh = CreateObject("WScript.Shell")
wsh.Run cmd, 0, True

' Skript beendet sich sofort!
WScript.Quit


' -------------------------------------------------------------
' 2. EIGENTLICHER VERSAND (wird erst zur Zielzeit ausgeführt)
' -------------------------------------------------------------
Sub SendKuchenTermin()
    Dim Outlook, appt, nextMonday, daysToMonday, rec1, rec2

    On Error Resume Next
    Set Outlook = CreateObject("Outlook.Application")
    If Outlook Is Nothing Then Exit Sub

    Set appt = Outlook.CreateItem(1)  ' 1 = olAppointmentItem

    ' Nächsten Montag berechnen
    daysToMonday = (8 - Weekday(Date, vbMonday)) Mod 7
    If daysToMonday = 0 Then
        daysToMonday = 7
    End If

    nextMonday = DateAdd("d", daysToMonday, Date) + TimeValue("14:15:00")

    ' Basisdaten
    appt.Subject = "KUCHEN oder suesse Teilchen !!!"
    appt.Start = nextMonday
    appt.Duration = 45
    appt.Location = "Im Office"
    appt.Body = "Liebe Kolleginnen und Kollegen," & vbCrLf & vbCrLf & _
    "es wurde festgestellt, dass ein Rechner unbeaufsichtigt und entsperrt zurueckgelassen wurde." & vbCrLf & _
    "Nach eingehender Analyse durch den zustaendigen KI-Agenten wurde die angemessene Gegenmassnahme eingeleitet:" & vbCrLf & _
    "KUCHEN." & vbCrLf & vbCrLf & _
    "Der Termin wurde daher bereits automatisch organisiert." & vbCrLf & _
    "Bitte erscheint zahlreich und unterstuetzt die konsequente Durchsetzung der IT-Sicherheitsrichtlinien." & vbCrLf & vbCrLf & _
    "Mit freundlichen Gruessen" & vbCrLf & _
    "Dein DE-420 KI-Agent" & vbCrLf & vbCrLf & _
    "PS: Bei auftretenden Anzeichen der sog. Calandor-Sabotaphobie (= der Angst, von Kollegen einen Kuchentermin eingestellt zu bekommen) fragen Sie Ihren KI-Doc"

    ' === Teilnehmer hinzufügen ===
    Set rec1 = appt.Recipients.Add("Yevheniy.Paul@bmw.de")
    rec1.Type = 1   ' 1 = erforderlich

    Set rec2 = appt.Recipients.Add("DE-420@list.bmw.com")
    rec2.Type = 1   ' 1 = erforderlich

    Set rec3 = appt.Recipients.Add("Philipp.Rottgardt@bmw.de")
    rec3.Type = 1   ' 1 = erforderlich

    appt.Recipients.ResolveAll
    appt.MeetingStatus = 1   ' 1 = olMeeting

    appt.Send

    ' Aufräumen: Task nach Ausführung wieder löschen
    Dim wshClean
    Set wshClean = CreateObject("WScript.Shell")
    wshClean.Run "schtasks /delete /tn """ & taskName & """ /f", 0, False
End Sub