Hallo zusammen

ich möche in VBA aus dem Outlook heraus einen Tast erstellen. Soweit funktioniert es.
Jedoch soll die Emai als Datei angefügt werden und nicht als Link. 
Wenn ich dies von Hand mache also im ToDo die Email anhänge, dann ist sie auch wirklich integriert. Mache ich des über VBA beim erstellen vom Task, wird nur der Link eingefügt.
Wenn ich nun einen Task delegieren möchte, muss die Email integriert sein. Da sie sonst vom Kollege nicht geöffnet werden kann.

Im code unten speichere ich die Datei und lade sie dann rein und auch mit dem Objekt direkt, hilft alles nichts. (.Attachments.Add objMail, olByValue, 1, "Test" ) greift hier nicht.
Hat hier jemand eine Idee?
 

Sub ConvertSelectedMailtoTask()
    Dim objTask As Outlook.TaskItem
    Dim objMail As Outlook.MailItem
    Dim sPath As String
    Dim dtDate As Date
    Dim sName As String
    Dim sPathName As String
    Dim enviro As String
      
    Set objTask = Application.CreateItem(olTaskItem)
    Set objMail = Application.ActiveExplorer.Selection.Item(1)
    
    enviro = CStr(Environ("USERPROFILE"))
    sPath = enviro & "\Documents\"
    sName = objMail.Subject
    
    ReplaceCharsForFileName sName, "_"
      
    dtDate = objMail.ReceivedTime
    sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & _
    Format(dtDate, "-hhnn", vbUseSystemDayOfWeek, vbUseSystem) & _
    "-" & sName & ".msg"
        
    sPathName = "D:\" + sName
    objMail.SaveAs sPathName, olMSG

    With objTask
        .Categories = objMail.Categories
        .Companies = objMail.Companies
        .Subject = objMail.Subject
        .DueDate = dtDate + 7
        .Body = objMail.Body
    'Add the message as an attachment
        .Attachments.Add objMail, olByValue, 1, "Test"
        .Attachments.Add sPathName
        .Save
    End With

    Set objTask = Nothing
    Set objMail = Nothing
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub