VBA to auto forward message with new subject and body text

melisa_d

New Member
Outlook version
Outlook on the web
Email Account
Office 365 Exchange
I know this gets asked a lot but none of the solutions I have found seem to be working for me. I am trying to auto forward an email from a specific sender and with a specific subject to a list of new recipients. I'm also trying to change the subject and body of the email when forwarding. I have Outlook 365 and I am using the following VBA code which gives me no errors but it doesn't do anything... What am I doing wrong? Or is this code just outdated? Please help! TIA!

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items

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 (objMail.SenderEmailAddress = "sender@test.com") And (objMail.Subject = "Test") Then

Set objForward = objMail.Forward

With objForward
.Subject = "Custom Subject"
.HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & objForward.HTMLBody
.Recipients.Add ("recipient1@gmail.com")
.Recipients.Add ("recipient2@gmx.at")
.Recipients.ResolveAll
.Send
End With
End If
End If
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
The code should work.

Did you set the macro security to low and restart outlook?

Change .Send to .Display during testing so you can see the message without actually sending it.

I often add msgbox "macro running" as the first line in macros that aren't working correctly to see if the msgbox comes up . If you use more than one msgbox, change 'macro running' to give a hint where you are in the code. Maybe add msgbox objInbox.name to the startup so you know it is running.


Although your code is fine, you can just use item as the object
Code:
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objForward As Outlook.MailItem

'see if it is running
msgbox item.subject

If TypeOf Item Is MailItem Then
If (item.SenderEmailAddress = "sender@test.com") And (item.Subject = "Test") Then

Set objForward = item.Forward

With objForward
.Subject = "Custom Subject"
.HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & objForward.HTMLBody
.Recipients.Add ("recipient1@gmail.com")
.Recipients.Add ("recipient2@gmx.at")
.Recipients.ResolveAll
.display
End With
End If
End If
End Sub
 

melisa_d

New Member
Outlook version
Outlook on the web
Email Account
Office 365 Exchange
I copied this exact code and sent a message to myself - absolutely nothing happens. No message, no emails forwarded. I selected "enabel all macros" and "apply macro security settings to add-ins" in outlook macro settings. I'm at a loss, must be doing something wrong...
 

melisa_d

New Member
Outlook version
Outlook on the web
Email Account
Office 365 Exchange
The code should work.

Did you set the macro security to low and restart outlook?

Change .Send to .Display during testing so you can see the message without actually sending it.

I often add msgbox "macro running" as the first line in macros that aren't working correctly to see if the msgbox comes up . If you use more than one msgbox, change 'macro running' to give a hint where you are in the code. Maybe add msgbox objInbox.name to the startup so you know it is running.


Although your code is fine, you can just use item as the object
Code:
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objForward As Outlook.MailItem

'see if it is running
msgbox item.subject

If TypeOf Item Is MailItem Then
If (item.SenderEmailAddress = "sender@test.com") And (item.Subject = "Test") Then

Set objForward = item.Forward

With objForward
.Subject = "Custom Subject"
.HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & objForward.HTMLBody
.Recipients.Add ("recipient1@gmail.com")
.Recipients.Add ("recipient2@gmx.at")
.Recipients.ResolveAll
.display
End With
End If
End If
End Sub
Basically I copied this code into the VBA window "this outlook session" and saved. Then exited Outlook and re-opened. Nothing at all happens when I send myself an email from the address I specified...
 

melisa_d

New Member
Outlook version
Outlook on the web
Email Account
Office 365 Exchange
Ok, so my original code suddenly worked somehow. I only have one more question. Is there a way to remove the "From", "Sent", "Subject" and "To" section that shows up on the bottom of the forwarded email?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Ok, so my original code suddenly worked somehow. I only have one more question. Is there a way to remove the "From", "Sent", "Subject" and "To" section that shows up on the bottom of the forwarded email?
Yes. use the original body in when you rebuild it. (use the object name you're using in your code).

.HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & item.HTMLBody
 
Top