Copy of incoming message is blank

Question

I'm trying to copy a message with an attachment and forward it to the specified address.

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.Account
      
    Set outlookApp = Outlook.Application
    'Set objectNS = outlookApp.GetNamespace("MAPI")
    'Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    Set objectNS = outlookApp.Session.Accounts.Item(2)
    Set inboxItems = objectNS.DeliveryStore.GetDefaultFolder(olFolderInbox).Items
End Sub
     
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    If TypeName(Item) = "MailItem" Then
        MsgBox ("debug msg")
        
        Dim oNS As Outlook.NameSpace
        Set oNS = Application.GetNamespace("MAPI")
        
        Dim myItem As Outlook.MailItem
        Dim myRecipient As Outlook.Recipient
        Set myItem = Application.CreateItem(olMailItem)
        Set myRecipient = myItem.Recipients.Add("[email protected]")
        myItem.Subject = Item.Subject
        myItem.SendUsingAccount = oNS.Accounts.Item(2)
        myItem.HTMLBody = Item.Body
        myItem.Display
        'myItem.Send
        
    End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

The script is launched at startup.
The event is triggered when an item appears in the inbox.
Since I have several accounts tied to Outlook, I use:

Set objectNS = outlookApp.Session.Accounts.Item(2)

The message body is not copied (for example, text + picture).

I tried:

myItem.HTMLBody = Item.RTFbody

or

myItem.HTMLBody = Item.HTMLbody

But the message remains blank.

Answer 1

Work with MailItem.Forward method (Outlook)

Example

Option Explicit
Public Sub Example()
    Dim Item As Outlook.MailItem
    Set Item = ActiveExplorer.Selection.Item(1)

    If TypeOf Item Is Outlook.MailItem Then
        Debug.Print Item.Subject
        FwItem Item
    End If

End Sub

Public Sub FwItem(ByVal Item As Object)
    Dim MsgFwd As Outlook.MailItem
    Set MsgFwd = Item.Forward
        MsgFwd.Subject = Item.Subject
        MsgFwd.Recipients.Add "[email protected]"
        MsgFwd.Save
        MsgFwd.HTMLBody = Item.HTMLBody
        MsgFwd.Send
End Sub