Extract and include senders email in forwarded message?

[perola.rike]

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?

[skatonni]

See Processing Incoming E-mails with Macros

Something like this where item is the incoming mail.

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

    Set newMail = Nothing

[perola.rike]

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?Forward mail code.docx

[skatonni]

Starting 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:

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

[skatonni]

I probably misunderstood the question.

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

[perola.rike]

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!