Send Mail item with mail content attached to Tasks in Outlook. Create the task date as mail receiving date.

Mail2Task.vb

Private Sub Application_ItemContextMenuDisplay( _
    ByVal CommandBar As Office.CommandBar, _
    ByVal Selection As Selection)

    Dim objButton As CommandBarButton

    On Error GoTo ErrRoutine
    
    If Selection.Count <> 0 Then
            If Selection.Item(1).Class = olMail Then
            Set objButton = CommandBar.Controls.Add( _
                msoControlButton)
            With objButton
                .Style = msoButtonIconAndCaption
                .Caption = "Send to Outlook Tasks"
                .FaceId = 355
                .OnAction = "Project1.ThisOutlookSession.Mail2Task"
            End With
            End If
    End If
    
EndRoutine:
    On Error GoTo 0
    ' Place clean-up code here.
    Exit Sub
    
ErrRoutine:
    MsgBox Err.Number & " - " & Err.Description, _
        vbOKOnly Or vbCritical, _
        "Application_ItemContextMenuDisplay"
    GoTo EndRoutine
End Sub

Private Sub Mail2Task()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objMailboxName As Outlook.MAPIFolder
    Dim olExp As Outlook.Explorer
    Dim olSel As Outlook.Selection
    Dim olTask As Outlook.TaskItem
    Dim olObj As Object
    Dim myEntryID As String
    Dim SelectedItem As MailItem
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    myEntryID = objNS.GetDefaultFolder(olFolderTasks).EntryID
    Set objMailboxName = objNS.GetFolderFromID(myEntryID)
    Set olExp = olApp.ActiveExplorer
    Set olSel = olExp.Selection
    
    
    
    For Each SelectedItem In olSel
        Set olTask = olApp.CreateItem(olTaskItem)
        Set olObj = SelectedItem
        olTask.Subject = SelectedItem.Subject & " - " & SelectedItem.ReceivedTime
        olTask.Attachments.Add olObj
        olTask.Body = SelectedItem.Body
        olTask.DueDate = Date
        'SelectedItem.MarkAsTask (0)
        SelectedItem.Save
        olTask.Save
        olTask.Move objMailboxName
    Next
        
End Sub

Private Sub Pick()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.Folder
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    MsgBox objFolder.EntryID
End Sub