Add text to auto-forwarded e-mail

Zelatvian

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hello,

I've seen variations of this question floating around all over, but I have not managed to figure out how to adapt any of them to this specific need. Probably because the first time I even opened VB was yesterday haha.

So the issue I'm having:
At the moment I have a rule in Outlook to auto-forward e-mails from a specific sender that contain specific words in the e-mail body to one or multiple recipients. What I would like to do, is to add some text in the forwarded e-mail body, i.e "Please find the approval below".. As I understand then this should be doable using VB in Outlook, but I simply cannot wrap my three brain cells around it. Any help/ideas would be much appreciated!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange

Zelatvian

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hi, Diane!

Thanks for the hint - I tried to use it, and upon execution, it tried to forward all of my existing emails which means I'm doing something wrong hahaha.

I'd need this macro to pick up only e-mails that meet specific criteria combination: sender, keyword, subject & then trigger the forward with a message & attachment added to the forwarded e-mail body. It seems that this would require to have a combination of codes?
 

Zelatvian

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hi, in case anyone ever should possibly need such a solution, here's the code that eventually worked for me:

Public Sub CreateCustomMail(item As Outlook.MailItem)
' Define new email object and variables
Dim NewEmail As Outlook.MailItem
Dim eRecipientsLV As String
Dim eRecipientsLT As String
Dim eRecipientsEE As String
Dim eBody As String

' Set values
Set NewEmail = item.Forward
' ## Change the eRecipients value to the name of your Contact Group
eRecipientsLV = "RecipientsLV"
'eRecipientsLT = "RecipientsLT"
'eRecipientsEE = "RecipientsEE"
' ## Change the addToBody value to change the text in your forwarded mail.
' ## NOTE: This is HTML formatted text
addToBody = "Hello, <p><p>please see for approval,<p><p><br>Zelatvian"

' incoming email attributes converted to string for string comparisson
Dim mailSubject As String
mailSubject = item.Subject

' Format and forward actual email
With NewEmail
If InStr(mailSubject, "LV") > 0 Then
.Recipients.Add (eRecipientsLV)
End If
If InStr(mailSubject, "LT") > 0 Then
.Recipients.Add (eRecipientsLT)
End If
If InStr(mailSubject, "EE") > 0 Then
.Recipients.Add (eRecipientsEE)
End If
.Subject = "RE: " & item.Subject
.BodyFormat = olFormatHTML
.HTMLBody = addToBody & .HTMLBody
End With

NewEmail.Send
Set item = Nothing
Set NewEmail = Nothing
End Sub
 

Lewis-H

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Try my code. It worked fine for me using <Alt-F8> to launch the macro. Of course, I placed the macro in the ThisOutlookSession module. I tested this on several messages that had the text and one or more inline image(s), as well as some that had an attachment too. If the original has LOTS of linked inline images, be patient, as it can take a while to retrieve all of the original linked images from their server. However, embedded images should load more quickly.

Once you're comfortable with the macro, you can get rid of the . Display line and/or un-comment the .Save and .Send lines if you desire. If you assign it to your button and/or custom keyboard shortcut, the forward will be very automated.

[vba]
Sub ForwardEmail()

Dim oExplorer As Outlook.Explorer
Dim oMail As MailItem
Set oExplorer = Application.ActiveExplorer
Set oMail = oExplorer.Selection.Item(1).Forward

On Error GoTo Release

If oExplorer.Selection.Item(1).Class = olMail Then
oMail.Subject = "FW: Personalized Subject Line"
oMail.HTMLBody = "Custom Text.<p> <img src=""custom image link""" _
& " title=""D"" alt=""D"" name=""D"" border=""0"" id=""D""/>" _
& vbCrLf & oMail.HTMLBody

oMail.Recipients.Add "xxx@xxx.com"
oMail.Recipients.Item(1).Resolve
If oMail.Recipients.Item(1).Resolved Then
oMail.Display
' oMail.Save
' oMail.Send
Else
MsgBox "Could not resolve " & oMail.Recipients.Item(1).address
End If
Else
MsgBox ("Not a mail item")
End If
Release:
Set oMail = Nothing
Set oExplorer = Nothing
End Sub
[/vba]

--
Lewis
 
Top