ramkumarcn
New member
- Joined
- Apr 19, 2013
- Messages
- 5
- Reaction score
- 0
- Points
- 0
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
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