Hallo Claude,

leider kann ich mit Deiner Vorlage wenig bis gar nichts anfangen, weil nach Kopie des Bodies in meinen Mailbereich das ganze völlig anders (nämlich auch unformatiert) aussieht.

Acceptance date : 06/10/2020 Request approved for Max Mustermann Request Date : 06/10/2020 Startdate Enddate Duration (per day) Start time 12/10/2020 12/10/2020 1 08:00 Applicant's Note : This is a test for auto mail to calendar

Außerdem bin ich Excel-getrieben und stelle nun fest, dass Du es wahrscheinlich durch Outlook getriggert in Outlook haben möchtest.

Nichts desto trotz habe ich mich noch mal daran versucht, aus dem Mailtext einen Kalendertermin zu erstellen. Die For-Schleife, die ich ursprünglich vorgesehen hatte,  damit alle Mails abgearbeitet werden, kann ggf. weg. Zur Zeit ist sie noch aktiv, nimmt aber nur die letzte und ungelesene Mail....

Ungelesen deshalb, damit bei Mehrfachlauf nicht die gleichen Termine mehrfach angelegt werden.

Ich habe das ganze auch mal in Outlook selbst (mein erstes Projekt dort :-)) getestet; da läuft es auch. Allerdings muss es von Hand angstoßen werden. Autotriggern ggf. mal googeln.

Also schau mal, ob Dich u.a. code dann schon etwas weiterbringt....

Option Explicit
Option Compare Text

Sub OL_Termin_Aus_Mail_Einstellen()
 Dim oOLApp As Object, oTermin As Object
 Dim i As Integer, j As Integer, sArr() As String, T As String
 Dim sBetreff As String, sAbsender As String, sMailtext As String

'Outlook-Instance holen bzw. neu anlegen, falls keine offen
 Set oOLApp = GetObject(vbNullString, "Outlook.Application")
 If oOLApp Is Nothing Then
    Set oOLApp = CreateObject("Outlook.Application")
 End If

'  With oOLApp.GetNamespace("MAPI").getdefaultfolder(6)  '6=olFolderInbox
 With oOLApp.GetNamespace("MAPI").Folders("voltmann-khan@t-online.de").Folders("Posteingang")

'Durchläuft alle Mails bzw. aktuell nur die letzte Mail
    For i = .Items.Count To .Items.Count
       With .Items(i)
         sAbsender = .SenderName
         sMailtext = .Body
'Erstellt einen Outlook-Termin
         If .Subject Like "Information MAIL*" And .UnRead = True Then    'Nur ungelesene Mail mit diesem Betreff nehmen
            On Error Resume Next
            sMailtext = Split(sMailtext, "Start time")(1)
            sMailtext = Split(sMailtext, "Applicant")(0)                 'Zeiten aus der Mail extrahieren
            If sMailtext <> "" Then
             sArr = Split(Trim$(sMailtext) & "   ")                      'restliche Mailangaben über " " splitten
            
             Set oTermin = oOLApp.CreateItem(1)                          'Kalendereintrag referenzieren
             With oTermin
               .Start = Format((sArr(0)), "dd.mm.yyyy") & " " & sArr(3)  'Startdatum und Uhrzeit
               .End = Format((sArr(1)), "dd.mm.yyyy") & " " & sArr(3)    'Endedatum und Uhrzeit
               sBetreff = Trim$(Split(.Subject & " for ", " for ")(1))   'Namen aus Betreff extrahieren
               .Subject = sBetreff                                       'Betreff einfügen
               .Body = "Termin für " & sBetreff                          'Body-Angaben
               .Location = "Ort nicht angegeben"                         'Ggf. Ort hinzufügen
               .Save                                                     'Termin speichern
               .Display                                                  'und anzeigen
             End With
             Set oTermin = Nothing
            End If
         End If
      
       End With
    Next i
 End With
 Set oOLApp = Nothing
 
End Sub

viele Grüße

Karl-Heinz