Excel VBA在转发的Outlook电子邮件中包含正文

2019年7月2日 275次阅读

我试图通过循环来转发基于A列中提供的主题的电子邮件.它工作得很好,但我还希望将C列中的内容包含在每个相应的邮件中.

同时从初始邮件中删除from和to详细信息.

《Excel VBA在转发的Outlook电子邮件中包含正文》

请求模板：

正文内容还应使用下面提到的列值.

《Excel VBA在转发的Outlook电子邮件中包含正文》

有人可以帮我删除并在下面包含这些细节..

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然后在您的Do循环中分配给列C EmailBody = .Cells(i,3).Value with

要从Item.Forward正文中删除以下内容,只需将您的Item.Body添加到您的MsgFwd.Body – 它应该仅使用Item.Body替换整个转发电子邮件正文

《Excel VBA在转发的Outlook电子邮件中包含正文》

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
点赞