How to auto forward, an email with attachments from sender, to more than one email address?

Question

I want when a specific email is delivered to my inbox to autoforward this email to multiple email addresses with the attachment and body but changing the subject.

Private Sub Application_Startup()
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInbox.Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
 
If TypeOf Item Is MailItem Then
    Set objMail = Item
 
    'If it is a specific new email
    If (objMail.SenderEmailAddress = "[email protected]") And _
      (objMail.Importance = olImportanceHigh) And _
      (objMail.Attachments.Count > 0) Then
 
        Set objForward = objMail.Forward
        'Customize the forward subject, body and recipients
        With objForward
            .Subject = "Custom Subject"
            .HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & _
              objForward.HTMLBody
            .Recipients.Add ("[email protected]")
            .Recipients.ResolveAll
            .Importance = olImportanceHigh
            .Send
        End With
    End If
End If
End Sub

Sub myAutoFW()

End Sub

I stand on the email in the inbox and run the macro but nothing happened.

Why not simply create a rule and forward the email to specific people? — QuickSilver
@QuickSilver you mean that create a rule and use this macro to forward mails? — user11463861
@Tim Williams Simply when some one send mail to me I want to forward this mail with the same attachment without download automatically by macro — user11463861
Is there a problem with your posted code? If not what is your specific problem ? How are you using your posted code? — Tim Williams

QuickSilver QuickSilver · Accepted Answer · 2019-05-25T21:37:20

You can try something like this. When you receive a new mail and is forwarded, it is expected that the forwarded mail generally goes at least to a new user and hence all the content remain as is (i.e. attachments aren't removed).

Sub ForwardEmail(item As Outlook.MailItem)
  Dim oMail As MailItem    

  On Error GoTo ErrorHandler
  If oMail.Attachments.Count > 0 Then
   If item.Class = olMail Then
     Set oMail = item.Forward
     With oMail
        .Subject = .Subject 'Can change the subject here
        .HTMLBody = "Please find attached." & vbCrLf & .HTMLBody
        .Recipients.Add "[email protected]" 'email address here
        .Save
        .Send
     End With
  End If
 End If
 ErrorHandler:
  Set oMail = Nothing
End Sub

How to auto forward, an email with attachments from sender, to more than one email address?

1 Answers