Forward incoming email with 4 embedded images in the body without original sender

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Hi,
I am trying to forward an email with 4 embedded images without original sender. The following script gets rid of the original sender, but the images are displaying as red X in the forwarded email. Direct forward set up as a rule displays the embedded images nicely, but with the original sender email. Is there a way to forward email with embedded images display and hide the original sender email at the same time?

Thank you for any help!

Sub SendTransfer(Item As Outlook.MailItem)

Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)

objMsg.HTMLBody = Item.HTMLBody
objMsg.Display
objMsg.Subject = "Transfers" & Item.Subject
objMsg.Recipients.Add "xxx@xxxx"

objMsg.Send

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Try using the word object model to copy and paste... not sure it will be any better though.

The macro at the bottom is for testing - select a message then run the macro - it beats sending test messages or running rules.

Code:
Sub SendTransfer(Item As Outlook.MailItem)

Dim objMsg As MailItem
   ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objWord As Word.Application
    Dim objInsp As Inspector
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
  
    On Error Resume Next
    
If Not Item Is Nothing Then
   If Item.Class = olMail Then
       Set objInsp = Item.GetInspector
       If objInsp.EditorType = olEditorWord Then
           Set objDoc = objInsp.WordEditor
           Set objWord = objDoc.Application
           Set objSel = objWord.Selection
   With objSel
      'use wholestory to copy the entire message body
        .WholeStory
        .Copy
  End With

       End If
   End If
End If
    
Set objMsg = Application.CreateItem(olMailItem)

 Set objInsp = objMsg.GetInspector
 Set objDoc = objInsp.WordEditor
 Set objSel = objDoc.Windows(1).Selection

With objMsg
    .Subject = "Transfers " & Item.Subject
    .Recipients.Add "xxx@xxxx"
     objSel.PasteAndFormat (wdFormatOriginalFormatting)
    .Display
    '.Send
End With

End Sub

Sub TestForwardMacro()
Dim objApp As Outlook.Application
Dim objItem As Object ' MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
SendTransfer objItem

End Sub
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Hi Diane,

Thank you for your response. The 'Dim objWord As Word.Application' was highlighted, and the following error message pop up. How to fix it?

1634148235591.png


Thank you,
fuz
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
I added the 16.0 word object library in the reference.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Oh sorry, I forgot to mention that you needed to reference the library. Did it do what you needed it to do?

Including images can be tough because they are attachments embedded in the HTML and just copying the body may not include them. If it doesn't work, removing the header block would be the next thing to try.
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Oh sorry, I forgot to mention that you needed to reference the library. Did it do what you needed it to do?

Including images can be tough because they are attachments embedded in the HTML and just copying the body may not include them. If it doesn't work, removing the header block would be the next thing to try.
There was a box popup saying 'an unknown error' has occurred. The email didn't get forwarded.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
It doesn't show you which line was the problem?

It works here when I select a message and run it (using the stub macro at the end). I didn't try it with a rule.
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Hi Diane,
The VBA window did not open up, so I didn't see which line was highlighted. The popup box has one line: the name of the script and message -an unknown error has occurred. BTW, am I supposed to put the lines of macro in the script? I didn't
Thank you,
Fuz
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This part is a separate macro, used to run the script on the selected message, so you don't need to send messages to test the rule.

Code:
Sub TestForwardMacro()
Dim objApp As Outlook.Application
Dim objItem As Object ' MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
SendTransfer objItem

End Sub


Select a message and run this macro - do you get the same error? If yes and it doesn't show you were it stopped, you can step through the macro to see where it is dying.
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Hi Diane,

Today the script does an unexpected thing. The incoming email arrives at 2 pm. At that time I happened to have some random sentences copied in my clip board. This script pasted the content what I had copied into the outgoing email and sent. (I ended up sending a strange email.) It seems the script didn't specify to copy the content in the incoming email that is specified by sender and subject within the rule prior to running the script. It sends whatever I copied at that moment instead. Please let me know your thoughts.

This is the script I am using

Code:
Sub SendTransfer(Item As Outlook.MailItem)
 
Dim objMsg As MailItem
   ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objWord As Word.Application
    Dim objInsp As Inspector
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
 
    On Error Resume Next
   
If Not Item Is Nothing Then
   If Item.Class = olMail Then
       Set objInsp = Item.GetInspector
       If objInsp.EditorType = olEditorWord Then
           Set objDoc = objInsp.WordEditor
           Set objWord = objDoc.Application
           Set objSel = objWord.Selection
   With objSel
      'use wholestory to copy the entire message body
        .WholeStory
        .Copy
  End With


       End If
   End If
End If
   
Set objMsg = Application.CreateItem(olMailItem)


 Set objInsp = objMsg.GetInspector
 Set objDoc = objInsp.WordEditor
 Set objSel = objDoc.Windows(1).Selection


With objMsg
    .Subject = "Transfers" & Item.Subject
    .Recipients.Add "xxx@xxx"
     objSel.PasteAndFormat (wdFormatOriginalFormatting)
    .Display
    .Send
End With




End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Best guess: it failed on the copy and pasted the last thing copied to the clipboard.

If you copied at the same time as the macro, it would pick up what was copied last. If you had a message open and was actively working in it, it could pick that up.

I usually run the macro manually to copy messages to tasks or appointments.
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Best guess: it failed on the copy and pasted the last thing copied to the clipboard.

If you copied at the same time as the macro, it would pick up what was copied last. If you had a message open and was actively working in it, it could pick that up.

I usually run the macro manually to copy messages to tasks or appointments.
So i should try not doing anything around the time (2 pm) to see if the rule that running the script would work?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
if you expect the messages that match the rule come in at 2PM, yeah, pause and see what happens. Comment out .send so you can see if it screws up before it sends. If it uses the last copied item, the problem is the copy code.
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Yes the problem is the copy code. It didn't copy anything from the content of the incoming email body.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
ok... it works manually, but not automated. Back to the drawing board...
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
BTW - a quick fix might be to add item.display before the inspector - it will flash on the screen and be annoying...


If Not Item Is Nothing Then
If Item.Class = olMail Then
item.display

<code to copy>

item.close <== can be early or after the message is sent
End If
End If
End If


- to close it later - add it after the message is sent

With objMsg
.Subject = "Transfers" & Item.Subject
.Recipients.Add "xxx@xxx"
objSel.PasteAndFormat (wdFormatOriginalFormatting)
.Display
.Send
End With

item.close
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Today I tested the following script and got a message. The VBA editor didn't open at all, so no code highlighted. I am going to test your suggestion tomorrow.

1634498003605.png



Code:
Sub SendTransfer(Item As Outlook.MailItem)
 
Dim objMail As Outlook.MailItem
    Dim objMailDocument As Word.Document
    Dim objDocSelection As Word.Selection
    Dim objNewMail As Outlook.MailItem
    Dim objNewMailDocument As Word.Document
    Dim objInlineShape As Word.InlineShape
    Dim objShape As Word.Shape
 
    'Get the source email
    Select Case Outlook.Application.ActiveWindow.Class
           Case olInspector
                Set objMail = ActiveInspector.CurrentItem
           Case olExplorer
                Set objMail = ActiveExplorer.Selection.Item(1)
    End Select
 
    'Copy the entire email to a new email
    Set objMailDocument = objMail.GetInspector.WordEditor
    Set objDocSelection = objMailDocument.Application.Selection
    objDocSelection.WholeStory
    objDocSelection.Copy
 
    Set objNewMail = Outlook.Application.CreateItem(olMailItem)
    objNewMail.Display
    Set objNewMailDocument = objNewMail.GetInspector.WordEditor
    objNewMailDocument.Application.Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
      

    For Each objInlineShape In objNewMailDocument.InlineShapes
        objInlineShape.ConvertToShape
    Next
 
    'Clear the text in the new email
    With objNewMailDocument.Content.Find
         .ClearFormatting
         .Replacement.ClearFormatting
         .Text = "[^2-^255]{1,}"
         .Replacement.Text = ""
         .MatchWildcards = True
         .Execute Replace:=wdReplaceAll
    End With
 
    Do While objNewMailDocument.Shapes.Count > 0
       For Each objShape In objNewMailDocument.Shapes
           objShape.ConvertToInlineShape
       Next
    Loop

With objNewMail
    .Subject = "Transfers" & Item.Subject
    .Recipients.Add "xx@xxx"
    .Send
End With


End Sub
 

fuz

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
Hi Diane,

Your suggestion got the following error. Do you know how to fix it?
1634596203786.png


Thank you,
Fuz
 
Similar threads
Thread starter Title Forum Replies Date
S Rule to Auto-forward/re-direct a specific incoming email to a group via BCC? Using Outlook 1
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
S Auto forward for multiple emails Outlook VBA and Custom Forms 0
G Forward email body to other mail list directly from Exchange server Exchange Server Administration 1
D auto forward base on email address in body email Outlook VBA and Custom Forms 0
Bering Forward selected email without the original email appended Outlook VBA and Custom Forms 0
C UDFs Reply vs Forward Outlook VBA and Custom Forms 3
M In Outlook Calendar remove the buttons: 'Today' and '<' (Back a day) and '>' (Forward a day) that are below the Ribbon and above the calendar display. Using Outlook 0
J Automatically forward email and apply template Outlook VBA and Custom Forms 0
O Forward a email with modified body Automatically. Outlook VBA and Custom Forms 0
C How to rename subject line and forward the email Outlook VBA and Custom Forms 2
R Error when trying to forward current email item Outlook VBA and Custom Forms 7
M Outlook macro to automate search and forward process Outlook VBA and Custom Forms 6
G Missing forward/replied icons Using Outlook 2
M VBA to auto forward message with new subject and body text Outlook VBA and Custom Forms 8
B Automatically Forward Emails and Remove/Replace All or Part of Body Outlook VBA and Custom Forms 8
M Forward Appointment as BCC with VBScript Outlook VBA and Custom Forms 7
B Forward every other email in Outlook 2013 Outlook VBA and Custom Forms 2
D Disable or hide "reply" and "reply to all" and "forward" in email from access vba Outlook VBA and Custom Forms 1
Sabastian Samuel HOW DO I FORWARD AN EMAIL WITH MACRO using an email that in the body of another email Outlook VBA and Custom Forms 3
C Don't forward duplicate Using Outlook 0
undercover_smother Automatically Forward All Sent Mail and Delete After Send Outlook VBA and Custom Forms 10
A Forward Outlook Email by Filtering using Macro Rule Outlook VBA and Custom Forms 44
I change subject and forward without FW: Outlook VBA and Custom Forms 4
C VBA to Forward e-mails from certain address and between certain times Outlook VBA and Custom Forms 1
J Forward Action in Form Outlook VBA and Custom Forms 1
J Auto Forward - Include Attachment and change Subject depending on original sender Outlook VBA and Custom Forms 3
K add pdf to every reply or forward Outlook VBA and Custom Forms 1
Brostin Forward a mail to the address listed in the email text Outlook VBA and Custom Forms 1
N Going Forward: Using Outlook 2016 for RSS Feeds Using Outlook 2
J Forward Message after editing attachments and include edited attachments Using Outlook 5
R changing FW: on forward Outlook VBA and Custom Forms 3
Z Auto Forward Using Outlook 4
N Outlook script to forward emails based on senders' address Outlook VBA and Custom Forms 2
S Merge Emails with attachments with inbox rule to forward Using Outlook 5
B Auto Save of Attachments from Multiple Emails and forward attachments to user group Outlook VBA and Custom Forms 1
A Creating an outlook rule to forward an email with a specific message Using Outlook 1
D Forward message to address from subject Outlook VBA and Custom Forms 1
D How to forward each email x minutes after it arrives in inbox and hasn't been moved or deleted? Using Outlook 1
W Macro to forward email Outlook VBA and Custom Forms 2
J How to change From then forward message Outlook VBA and Custom Forms 1
S Reply & Forward Date in original message incorrect Using Outlook 2
Diane Poremsky Forward Messages that were not Replied To Using Outlook 0
mikecox Forward email to another address; not with Rules Using Outlook 3
divan Macro to format email in a certain folder then forward to email address Using Outlook 3
D forward email with attachment using .oft Using Outlook 3
J Outlook 2010: can't forward appointment on custom form Using Outlook 1
J Forward a bounce mail? Using Outlook 1
P How to save sent mail and forward it the next day Exchange Server Administration 3
T outlook 2013 does not mark multiple forward messages as forward Using Outlook 2

Similar threads

Top