asked on

Outlook Macro to forward email and add text

HI All,

I have created the below macro.

The idea is an email is recieved, the user clicks on a button which runs the macro.
The macros job is to forward the original email, add text to the email at the top, such as 'Logged by ....', and to keep the original email and subject, and send the forwarded email to a specific address.

The problem:
The problem is that the emaik forwards and adds the text fine. But the email does not remain in HTML format in which it is recieved, also images are stripped from it.
Further to this, I am kinda of looking for 'Logged by ...' then a break line, as if to show the old email below, like OUtlook does automatically when you forward the email......

Please let me know any thoughts

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
 
 
Public Sub email()
Sub UpdatedCall()
    Dim objApp As Application
    Dim objSelection As Selection
    Dim blnDoIt As Boolean
    Dim i As Integer
    Dim strMsg As String
    Dim y As Integer
   
    
    Set objApp = CreateObject("Outlook.Application")
    Set objSelection = objApp.ActiveExplorer.Selection
    
    blnDoIt = False
        ' If no messages selected, tell the user
    If objSelection.Count = 0 Then
        Call Email_not_selected
    ElseIf objSelection.Count = 1 Then
        ' 1 message selected, just do it
        blnDoIt = True
    Else
        ' Added in this so can't select more then 1 email
    y = MsgBox(Prompt:="You can not select more then one email.", _
            Buttons:=vbDefaultButton2, _
            Title:="Unrecognized Selection")
    End If
    
    If blnDoIt = True Then
        Call Updated2(objSelection)
        Beep ' alert the user that we're done
    End If
    Set objSelection = Nothing
    Set objApp = Nothing
End Sub
 
 
' Tell user that no email message was selected
Sub Email_not_selected()
 
    Dim i As Integer
    i = MsgBox(Prompt:="No Email was selected. Please select an email first.", _
            Buttons:=vbDefaultButton2, _
            Title:="Unrecognized Selection")
End Sub
 
 
' For all selected messages, send to the specified mail address, then
' delete the message.
 
Sub Updated2(objSel As Selection)
    Dim objItem As Object
    Dim intOKToExceedMax As Integer
        
    'Get all selected items
    Set MyOlApplication = CreateObject("Outlook.Application")
    Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
    Set MyOlSelection = MyOlApplication.ActiveExplorer.Selection
 
    'Make sure at least one item is selected
    If MyOlSelection.Count = 0 Then
       Response = MsgBox("Please select an item first", vbExclamation, MyApplName)
       Exit Sub
    End If
        
    'Retrieve the selected item
    Set MySelectedItem = MyOlSelection.Item(1)
    
    'note, used to have items to extract the attachments and save them
    'these have now been removed, but the cleanup left
    
    'Cleanup
    Set objAttachment = Nothing
    Set colAttachments = Nothing
    Set MyOlApplication = Nothing
    Set MyOlNameSpace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing
    
    '######################################
    For Each objItem In objSel
        ' Forward to the specified mail address
        Set myforward = objItem.Forward
        myforward.Recipients.Add "#####"
            'Text for the forwarded email
            'SPM ammended Email body
            myforward.Body = "Updated by SPM" + vbCrLf + vbCrLf + vbCrLf + "Original Message Below" + vbCrLf + "_____________________________________________" + vbCrLf + vbCrLf + objItem.Body
                'Send email
                myforward.Send
    Next
    Set myforward = Nothing
    Set objItem = Nothing
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

David Lee

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Morrisproject

ASKER

you are an ABSOLUTE LEGEND!

Thanks for this it works great

Following on from this, do you know how to enter the break line through outlook. For example when you forward an email in outlook, a break line is put in to show the previous email below.

I would like to enter this is VBA....

Morrisproject

ASKER

Further to this,

If this is simple.

I need a macro to simply enter a name into the Bcc box, of an open email. But not sure where to start with this one!

David Lee

"do you know how to enter the break line through outlook"
The HTML <hr> tag will give you a break line.

"I need a macro to simply enter a name into the Bcc box"
Below.

Sub InsertBCC()
    Application.ActiveInspector.CurrentItem.BCC = "someone@company.com"
End Sub

Open in new window

Morrisproject

ASKER

Thanks BlueDevilFan,

You cannot understand how greatful I am.

One more before I go. Is there anyway to add the From as well to the Bcc Macro.

Thanks

David Lee

You're welcome.

See below.

Sub InsertBCC()
    Application.ActiveInspector.CurrentItem.BCC = "someone@company.com"
    Application.ActiveInspector.CurrentItem.SentOnBehalfOfName = "Some Name"
End Sub

Open in new window

Morrisproject

ASKER

Thanks for this.

Although the sentonbehalfofname doesn't seem to populate the From field.

Further to this, when an email is forwarded using the macro I created above it does not show the time stamp and previous email information, like an email forwarded directly from Outlook. Is there any easy way to add this information?

Thanks again

David Lee

1. "Although the sentonbehalfofname doesn't seem to populate the From field."
It appears to depend on when the value is set. Try the code in the snippet and you'll see that the value can be set. But, you're right that it doesn't work when attempting to set the value after the item is created. If you incorporate the code for setting the From value into the code you already have for forwarding the item, then it'll work. In other words

Set olkMsg = objItem.Forward
olkMsg.SentOnBehalfOfName = "someone@company.com"
olkMsg.Display

2. To get the forward to appear the way you want change line 95 to

myforward.HTMLBody = "Updated by SPM<br><br>" + myforward.HTMLBody

This inserts "Updated by SPM" immediately before the already existing forwarding information.

Sub SetFrom()
    Dim olkMsg As Outlook.MailItem
    Set olkMsg = Application.CreateItem(olMailItem)
    olkMsg.SentOnBehalfOfName = "someone@company.com"
    olkMsg.Display
End Sub

Open in new window

Morrisproject

ASKER

Thanks for this BlueDevilFan,

Sorry if I confused the From part. It was kinda of a seperate question, I will log it some other time and let you know when this is done so you can be awarded the points.

One more thing, I know this seems endless, but you are an amazing VBA guru :-)
Ideally when the email comes in, the macro is run to forward the email onto the address. I would also like the original emails text to become on the clipboard. Is there any way to integrate something which can copy the timestamps of the email (i.e. what shows when forwarded) and the emails text onto the clipboard, to then be pasted elsewhere....

Thanks

David Lee

"you are an amazing VBA guru"
Thanks! My email address is in my contact information, so anytime you post a question that you'd like me to look at you can send me a message with a link to the question and I'll have a look.

I'll be glad to answer any and all questions I can, but in fairness they need to be separate questions. I'm not looking to make more points, you're welcome to assign whatever point value you think is appropriate. At some point in the future another EE member is going to do a search and find this question in their list of answers and when they read through it they're going to find that it wondered a lot from the original question into all these sub-questions which didn't really have anything to do with the original question. That can be confusing to a reader, especially as the thread gets longer and longer.

That being said, yes, it's possible to copy information from a message to the clipboard. If this macro is running automatically though, say via a rule, then I see a problem. Copying to the clipboard is destructive. Message one arrives and the data is copied to the clipboard. Before you can paste the clipboard data message two arrives. When the data from it is put on the clipboard the data from message one goes away. If you want to put data on the clipboard, then I'll be glad to post the code. I'd prefer that you open another question for that, but will provide the code even if you don't.

Morrisproject

ASKER

Many thanks for BlueDevilFan, who was extremely helpful on acheiving exactly what I desired.

David Lee

You're welcome. Glad I could help out.