Excel VBA将正文包含在转发的Outlook电子邮件中 [英] Excel VBA to include body in the forwarded outlook email
问题描述
我正在尝试通过循环转发基于A列中提供的主题的电子邮件.它的工作正常,但我也想将C列中的内容包括到每个相应的邮件中.
I am trying to forward emails based on the subject provided in the A column by looping. Its working perfectly, but I would also like to include the content in the C column to each of the corresponding mail.
还要从初始邮件中删除发件人和收件人的详细信息.
Also delete the from and to details from the initial mail.
请求模板:
正文内容还应使用如下所述的列值.
The body content should also use the column value as mentioned below.
有人可以帮我删除此详细信息并将其包含在下面吗?
Can some one help me remove and include this details in the below..
Option Explicit
Public Sub Example()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Item As Variant
Dim MsgFwd As MailItem
Dim Items As Outlook.Items
Dim Email As String
Dim Email1 As String
Dim ItemSubject As String
Dim lngCount As Long
Dim i As Long
Dim RecipTo As Recipient
Dim RecipCC As Recipient
Dim RecipBCC As Recipient
Dim onbehalf As Variant
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items
i = 2 ' i = Row 2
With Worksheets("Sheet1") ' Sheet Name
Do Until IsEmpty(.Cells(i, 1))
ItemSubject = .Cells(i, 1).Value '(i, 1) = (Row 2,Column 1)
Email = .Cells(i, 16).Value '(i, 2) = (Row 2,Column 2)
Email1 = .Cells(i, 2).Value
'// Loop through Inbox Items backwards
For lngCount = Items.Count To 1 Step -1
Set Item = Items.Item(lngCount)
If Item.Subject = ItemSubject Then ' if Subject found then
Set MsgFwd = Item.Forward
Set RecipTo = MsgFwd.Recipients.Add(Email1) ' add To Recipient
Set RecipTo = MsgFwd.Recipients.Add("sen@aa.com")
Set RecipBCC = MsgFwd.Recipients.Add(Email) ' add BCC Recipient
MsgFwd.SentOnBehalfOfName = "doc@aa.com"
RecipTo.Type = olTo
RecipBCC.Type = olBCC
MsgFwd.Display
End If
Next ' exit loop
i = i + 1 ' = Row 2 + 1 = Row 3
Loop
End With
Set olApp = Nothing
Set olNs = Nothing
Set Inbox = Nothing
Set Item = Nothing
Set MsgFwd = Nothing
Set Items = Nothing
MsgBox "Mail sent"
End Sub
推荐答案
将新变量添加为字符串 Dim EmailBody As String
,然后将分配给C列 EmailBody = .Cells(i, 3).Value
Do Loop
Add new variable as string Dim EmailBody As String
then assign to column C EmailBody = .Cells(i, 3).Value
with in your Do Loop
要从 Item.Forward
正文中删除以下内容,只需将 Item.Body
添加到 MsgFwd.Body
-它应替换整个转发电子邮件正文,仅包含Item.Body
MsgFwd.HTMLBody = EmailBody & "<BR>" & "<BR>" & Item.HTMLBody
MsgFwd.HTMLBody = EmailBody & "<BR>" & "<BR>" & Item.HTMLBody
示例
Dim EmailBody As String
With Worksheets("Sheet1") ' Sheet Name
Do Until IsEmpty(.Cells(i, 1))
ItemSubject = .Cells(i, 1).Value '(i, 1) = (Row 2,Column 1)
Email = .Cells(i, 16).Value '(i, 2) = (Row 2,Column 2)
Email1 = .Cells(i, 2).Value
EmailBody = .Cells(i, 3).Value
'// Loop through Inbox Items backwards
For lngCount = Items.Count To 1 Step -1
Set Item = Items.Item(lngCount)
If Item.Subject = ItemSubject Then ' if Subject found then
Set MsgFwd = Item.Forward
Set RecipTo = MsgFwd.Recipients.Add(Email1) ' add To Recipient
Set RecipTo = MsgFwd.Recipients.Add("sen@aa.com")
Set RecipBCC = MsgFwd.Recipients.Add(Email) ' add BCC Recipient
MsgFwd.SentOnBehalfOfName = "doc@aa.com"
RecipTo.Type = olTo
RecipBCC.Type = olBCC
Debug.Print Item.Body ' Immediate Window
MsgFwd.HTMLBody = EmailBody & "<BR>" & "<BR>" & Item.HTMLBody
MsgFwd.Display
End If
Next ' exit loop
这篇关于Excel VBA将正文包含在转发的Outlook电子邮件中的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!