メールを転送するマクロを設計しました。以下のコードは、転送メールの下書きを作成し、本文にいくつかの情報を追加し、メールの下部に元のコンテンツを保持します。ただし、唯一の問題は、マクロが電子メールを転送しようとすると、元の形式が失われることです。
また、デフォルトでは、自分のメール ID が From アドレスとして表示されます。代わりに、「ops@ccorp.com」にする必要があります。手伝っていただけませんか?
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