Question

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

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

我不确定如何将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

如何复制/复制Outlook MailItem

1 个答案: