Hi,

I have designed a macro to forward an email. The below code drafts a forward email, adds some information in the body, retains the original content at the bottom of the email. But the only problem is, when the macro attempts to forward the email, the original format is getting lost.

Also, by default, it displays my email id as From Address. Instead, it should be "ops@ccorp.com". Could you please help me?

Sub Forward_Email()


Set objOL = CreateObject("Outlook.Application")
Set objMsg = objOL.ActiveInspector.CurrentItem
Set objForward = objMsg.Forward
objForward.Recipients.Add "someone@example.com"
objForward.CC = "eg1@example.com"


objOrignialBody = objForward.Body
Workbooks.Open Filename:= _
"C:\Users\desktop\Email Distribution Control File.xlsx"
Sheets("Incorrect Device Type").Select
EmailLastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row


Cells.Find(What:="Subject", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Activate


BodyofEmail = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
For emailrange = 6 To EmailLastRow - 1
If ActiveCell.Row > EmailLastRow Then
GoTo DraftEmail
Else
End If
BodyofEmail = BodyofEmail & vbCrLf & ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Next emailrange


DraftEmail:


objForward.Display
objForward.Body = BodyofEmail & vbCr & vbCr & vbCr & objOrignialBody