Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 5766
  • Last Modified:

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

0
Morrisproject
Asked:
Morrisproject
  • 6
  • 6
1 Solution
 
David LeeCommented:
Hi, Morrisproject.

"But the email does not remain in HTML format in which it is recieved, also images are stripped from it."
Line 95 is responsible for this.  Change myforward.Body to myforward.HTMLBody and objItem.Body to objItem.HTMLBody, and change all occurrences of  vbCrLf to "<br>" and you'll be in business.
1
 
MorrisprojectAuthor Commented:
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....
0
 
MorrisprojectAuthor Commented:
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!
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
David LeeCommented:
"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

0
 
MorrisprojectAuthor Commented:
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
0
 
David LeeCommented:
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

0
 
MorrisprojectAuthor Commented:
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
0
 
David LeeCommented:
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

0
 
MorrisprojectAuthor Commented:
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
0
 
David LeeCommented:
"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.
1
 
MorrisprojectAuthor Commented:
Many thanks for BlueDevilFan, who was extremely helpful on acheiving exactly what I desired.
0
 
David LeeCommented:
You're welcome.  Glad I could help out.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now