如何复制/复制Outlook MailItem

Question

我有一个用户将eMails发送到一个大的" to“列表，有时超过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