Hallo,

ich konnte mir die Mail mit dem o.a. HTML-Text erfolgreich zusenden. Anliegend mal ein (erster) geänderter Ansatz, aus dem Du aus so einer Mail dann den Termin erstellen könntest.

Die Einbettung in das Outlook-fähige Muster von Trägheit konnte ich noch nicht umsetzen, da ich jetzt weg muss und bis Sonntag abend offline bin.

Solltest Du bis dahin keinen eigenen Erfolg haben oder anderweitig Hilfe erfahren, können wir das dann gerne ab Montag forsetzen.

Ein schönes Wochenende

Karl-Heinz

Sub OL_Termin_Aus_Mail_Einstellen()
 Dim oOLApp As Object, oTermin As Object
 Dim i As Integer, j As Integer, sArr() As String
 Dim sZeit As String, sStart As String, sEnd 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
            sArr = Split(sMailtext, vbLf) 'Zeiten aus der Mail extrahieren
            If sMailtext <> "" Then
             For j = 0 To UBound(sArr)
              If Trim$(sArr(j)) Like "Starttime*" Then Exit For
             Next j
'Zeiten extrahieren
             sStart = Trim$(Replace(sArr(j + 2), vbLf, ""))              'Startdatum
             sEnd = Trim$(Replace(sArr(j + 4), vbLf, ""))                'Endedatum
             sZeit = Trim$(Replace(sArr(j + 8), vbLf, ""))               'Zeit
             
             Set oTermin = oOLApp.CreateItem(1)                          'Kalendereintrag referenzieren
             With oTermin
               .Start = Format(sStart, "dd.mm.yyyy") & " " & sZeit       'Startdatum und Uhrzeit
               .End = Format(sEnd, "dd.mm.yyyy") & " " & sZeit           '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