Extract and include senders email in forwarded message?

I have a code in the vba-module "This outlook session" that forwards all my outlook mail to my gmail account. What I need is a code (if possible) that inserts the original senders email in the forwarded message. Is this possible?

See Processing Incoming E-mails with Macros

Something like this where item is the incoming mail.

Code:

---

    Dim newMail As mailItem
                   
    Set newMail = CreateItem(olMailItem)
       
    With newMail
        .To = "address"
        .Attachments.Add Item
        .Display ' .Send
    End With

    Set newMail = Nothing

---

Thank you for answering, I did some testing, but the code you suggested caused Outclook to crash/restart.... I have the following attached code pasted in "This outlook session". Any ideas how to integrate your suggested code with my code?Attachment 14954

Starting code:

Code:

---

Public Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim varEntryID As Variant
   
    On Error Resume Next
 
    For Each varEntryID In Split(EntryIDCollection, ",")
        Dim objOriginalItem As mailItem
        Set objOriginalItem = Application.GetNamespace("MAPI").GetItemFromID(varEntryID)
        Dim objForwardedItem As mailItem
        Set objForwardedItem = objOriginalItem.Forward
        Do Until objForwardedItem.Attachments.count = 0
            objForwardedItem.Attachments.Remove (1)
        Loop
 
        objForwardedItem.To = "address"
        objForwardedItem.send
    Next
End Sub

---

Revised code something like this:

Code:

---

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
   
    Dim varEntryID As Variant
   
    Dim objOriginalItem As mailItem
    Dim newMail As mailItem

    On Error Resume Next
 
    For Each varEntryID In Split(EntryIDCollection, ",")
       
        Set objOriginalItem = Application.GetNamespace("MAPI").GetItemFromID(varEntryID)

        Do Until objOriginalItem.Attachments.count = 0
            objOriginalItem.Attachments.Remove (1)
        Loop

        Set newMail = CreateItem(olMailItem)
 
        With newMail
            .To = "address"
            .Attachments.Add objOriginalItem
            .Display ' .Send
        End With
       
    Next
   
ExitRoutine:
    Set objOriginalItem = Nothing
    Set newMail = Nothing
   
End Sub

---

I probably misunderstood the question.

Code:

---

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
   
    Dim varEntryID As Variant
   
    'On Error Resume Next ' Not a good idea
   
    For Each varEntryID In Split(EntryIDCollection, ",")
   
        Dim objOriginalItem As Object
        Set objOriginalItem = Application.GetNamespace("MAPI").GetItemFromID(varEntryID)
       
        Dim objForwardedItem As mailItem
       
        If TypeOf objOriginalItem Is mailItem Then
       
            Set objForwardedItem = objOriginalItem.Forward
            Do Until objForwardedItem.Attachments.count = 0
                objForwardedItem.Attachments.Remove (1)
            Loop
       
            objForwardedItem.To = "address"
            objForwardedItem.Display
       
            objForwardedItem.HTMLBody = objOriginalItem.SenderEmailAddress & objForwardedItem.HTMLBody
       
            ' or
            'objForwardedItem.body = objOriginalItem.SenderEmailAddress & objForwardedItem.body
       
            'objForwardedItem.send
           
        End If
   
    Next
End Sub

---

Thank you! I tried your first suggestion which worked nice - it included the original sender's email adress (as a text string) in the forwarded mail (exactly what I needed)!

Looking forward to test your last code as well!