Set Outlook = CreateObject("Outlook.Application")
Set appt = Outlook.CreateItem(1)  ' 1 = olAppointmentItem

' Nächsten Montag um 15:00 Uhr berechnen
Dim nextMonday, daysToMonday

daysToMonday = (8 - Weekday(Date, vbMonday)) Mod 7

' Wenn heute Montag ist, den kommenden Montag wählen
If daysToMonday = 0 Then
    daysToMonday = 7
End If

nextMonday = DateAdd("d", daysToMonday, Date) + TimeValue("14:15:00")


' Basisdaten
appt.Subject = "KUCHEN"
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"


' === Teilnehmer hinzufügen ===
' Pflichtteilnehmer
 Set rec1 = appt.Recipients.Add("DE-420@list.bmw.com")
 rec1.Type = 1   ' 1 = erforderlich

Set rec2 = appt.Recipients.Add("Simon.Reindl@bmw.de")
rec2.Type = 1   ' erforderlich

Set rec3 = appt.Recipients.Add("Yevheniy.Paul@bmw.de")
rec3.Type = 1   ' erforderlich

' Optional: Namensauflösung prüfen
appt.Recipients.ResolveAll

' Termin als Meeting senden (WICHTIG!)
appt.MeetingStatus = 1   ' macht daraus eine Besprechung

' Senden oder nur anzeigen
appt.Send
' appt.Display   ' alternativ zum Prüfen