如何复制/复制 Outlook MailItem

Question

我有一个用户将eMails 发送到一个大的“收件人”列表，有时超过 20 个地址。有了这么大的"To" 列表，收到的邮件有时会出现在收件人的垃圾邮件文件夹中。显然，我们希望避免这种情况。

我的想法是让用户创建一个原始的eMail，然后运行一个宏。宏将遍历 Excel 工作表中的所有eMail 地址，然后复制原始消息并将其单独发送给每个收件人。

我不确定如何将MailItem 从原始MailItem 复制到新的MailItem。 Excel 循环工作正常。

这是我的缩写宏：

Option Explicit
Sub Send_emails()
'.
'.
Set objDoc = objInspector.WordEditor
Set objWrdApp = objDoc.Application
Set objSelection = objWrdApp.Selection
'Loop through the Rows in the worksheet.  Start at row 2 to ignore header
For lngCurrSheetRow = 2 To lngLastSheetRow
    strEmailAddress = objWorksheet.Cells(lngCurrSheetRow, 1).Value
    'Set objNewMail so that the new message is created and can be referenced.
    Set objNewMail = Application.CreateItem(0)
    With objNewMail
        .Body = objSelection
        .To = strEmailAddress
    End With
Next lngCurrSheetRow
'.
'.
End Sub

Answer 1

复制 mailitem.body 的例子是

Option Explicit
Sub Send_emails()

        Dim olMsg As Outlook.MailItem
        Set olMsg = ActiveExplorer.Selection.Item(1)

        Dim objNewMail As Outlook.MailItem
        Set objNewMail = Application.CreateItem(0)

        With objNewMail
            .Body = olMsg.Body
            .Display
        End With
End Sub

对于 HTML 正文，只需执行 HTMLBody = olMsg.HTMLBody