Mit folgendem letztem HTML Mail Body:

^ Mit dem habe ich es zuletzt getestet.

'#####################################
' Klassenmodul: ThisOutlookSession
'#####################################
'#
'# version: 0.1.3
'#  author: Trägheit
'#    date: 13.10.2020
'#
'# benötigt Verweis auf:
'#  * 'Microsoft HTML Object Library'
'#
Option Explicit
 
Private Type MailDataType
  AcceptanceDate  As Date
  RequestDate     As Date
  StartDate       As Date
  EndDate         As Date
  DurationPerDay  As Integer
  RequestFor      As String
End Type
 
'#####################################
'# Dieses Ereignis tritt ein, wenn eine oder mehrere Mails erhalten wurden
'# (Mails = Termine, Terminserien, Aufgabe, Text-Mail, usw.)
Private Sub Application_NewMail()
   
  Dim objItems As Outlook.Items

  Set objItems = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items

  'nach ungelesenen MailItems filtern
  Set objItems = objItems.Restrict("[UnRead] = True AND [MessageClass] = 'IPM.Note'")
  'aufsteigend sortieren nach Datum
  ' (Items müssen sortiert werden; ihre Reihenfolge ist sonst unbestimmt)
  Call objItems.Sort("SentOn")

  Dim objMailItem As Outlook.MailItem
  Dim udtMailData As MailDataType
  
  For Each objMailItem In objItems
     
    udtMailData = EmptyMailDataType()
    
    If GetMailData(objMailItem.HTMLBody, udtMailData) Then
       
      'Ausgabe - hier käme dann die Erstellung des Termins / Kalendereintrags
      Debug.Print String(15, "-")
      Debug.Print "AcceptanceDate: "; udtMailData.AcceptanceDate
      Debug.Print "   RequestDate: "; udtMailData.RequestDate
      Debug.Print "    RequestFor: "; "'"; udtMailData.RequestFor; "'"
      Debug.Print "          From: "; DateValue(udtMailData.StartDate); "(Start: "; TimeValue(udtMailData.StartDate); ")"
      Debug.Print "            To: "; udtMailData.EndDate
       
      'als gelesen markieren
'      objMailItem.UnRead = False
       
'      Call MsgBox("Laden der Daten war erfolgreich.", vbInformation)
       
    Else
'      Call MsgBox("Laden der Daten ist leider fehlgeschlagen.", vbExclamation)
    End If
  Next
   
End Sub
 
'#####################################
'# Läd HTML und sucht HTML Tabelle für den Einsprung zum Lesen der Daten
Private Function GetMailData(MailContentHTML As String, ByRef MailData As MailDataType) As Boolean
  Dim objHTML As MSHTML.HTMLDocument
  Set objHTML = New MSHTML.HTMLDocument
  Call CallByName(objHTML, "writeln", VbMethod, MailContentHTML)
  With objHTML.DocumentElement
    With .getElementsByTagName("TABLE")
      If .Length > 0 Then
        GetMailData = FetchMailData(.Item(0), MailData)
      End If
    End With
  End With
End Function
 
'#####################################
'# HTML Daten lesen, mit HTML Tabelle als Einsprungspunkt
Private Function FetchMailData(HTMLTable As MSHTML.HTMLTable, ByRef MailData As MailDataType) As Boolean
   
  On Error GoTo ErrHandler
   
'# Daten oberhalb von HTMLTable lesen
  With CreateObject("VBScript.RegExp")
     
    .Global = True
    .IgnoreCase = True
    .MultiLine = True
     
    Dim str As String
'    "Acceptance date : 06/10/2020"
'    "Request approved for Max Mustermann"
'    "Request Date : 06/10/2020"
    str = HTMLTable.PreviousSibling.innerText
     
'    "Request approved for Max Mustermann"     -> "Request approved for : Max Mustermann"
    .Pattern = "\bfor\b"
    str = .Replace(str, "for :")
     
'    "Acceptance date : 06/10/2020"            -> '06/10/2020'
'    "Request approved for : Max Mustermann"   -> 'Max Mustermann'
'    "Request Date : 06/10/2020"               -> '06/10/2020'
    .Pattern = ":\s*\b(.+)\b\s$"
    With .Execute(str)
      MailData.AcceptanceDate = DateConv(.Item(0).SubMatches(0))
      MailData.RequestFor = .Item(1).SubMatches(0)
      MailData.RequestDate = DateConv(.Item(2).SubMatches(0))
    End With
     
  End With
   
'# Daten aus von HTMLTable lesen
  Dim tableRow  As MSHTML.HTMLTableRow
  Dim tableCell As MSHTML.HTMLTableCell
  Dim i         As Long
   
  With HTMLTable.Rows(1).Cells '1 = zweite Zeile in Tabelle
    For i = 0 To .Length - 1
      'Wertezuweisung anhand Spaltenindex
      Select Case i
        Case 0 'Startdate
          MailData.StartDate = DateConv(.Item(i).innerText)
        Case 1 'Enddate
          MailData.EndDate = DateConv(.Item(i).innerText)
        Case 2 'Duration (per day)
          MailData.DurationPerDay = Trim(.Item(i).innerText)
        Case 3 'Starttime
          MailData.StartDate = MailData.StartDate + TimeValue(.Item(i).innerText)
      End Select
    Next
  End With
   
  FetchMailData = True
   
Exit Function
ErrHandler:
  FetchMailData = False
  MailData = EmptyMailDataType()
End Function
 
'#####################################
'# Datums-Format handhaben
Private Function DateConv(Expr As String) As Date
  With CreateObject("VBScript.RegExp")
    .Pattern = "(\d{2})/(\d{2})/(\d{4})"
    '#MM/DD/YYYY#   #YYYY-MM-DD#
    ' 06/10/2020' => 2020-06-10
    DateConv = DateValue(.Replace(Expr, "$3-$1-$2"))
  End With
End Function
 
'#####################################
'#
Private Function EmptyMailDataType() As MailDataType
  'nix zu tun hier - cool! :]
End Function

Um uns beide mal auf den Aktuellen Stand zu bringen. ;)

Grüße