通过 Excel VBA 发送带附件的电子邮件

Question

我想通过 Outlook 从 Excel 通过电子邮件发送报告。

我正在使用我自己和同事的电子邮件地址对此进行测试。我收到“无法送达”的消息Error。

该消息表示无法联系到收件人，并建议稍后尝试发送电子邮件。

Sub CreateEmail()

Dim OlApp As Object
Dim OlMail As Object
Dim ToRecipient As Variant
Dim CcRecipient As Variant

Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.createitem(olmailitem)

For Each ToRecipient In Array("jon.doe@aol.com")
    OlMail.Recipients.Add ToRecipient
Next ToRecipient

For Each CcRecipient In Array("jon.doe@aol.com")
    With OlMail.Recipients.Add(CcRecipient)
        .Type = olCC
    End With
Next CcRecipient

'Fill in Subject field
OlMail.Subject = "Open Payable Receivable"

'Add the report as an attachment
OlMail.Attachments.Add ("C:\OpenPayRecPrint2.pdf")

'Send Message
OlMail.Send

End Sub

Answer 1

确保引用 Outlook 对象库

Option Explicit
Sub CreateEmail()

    Dim OlApp As Object
    Dim OlMail As Object
    Dim ToRecipient As Variant
    Dim CcRecipient As Variant

    Set OlApp = CreateObject("Outlook.Application")
    Set OlMail = OlApp.createitem(olmailitem)

    For Each ToRecipient In Array("jon.doe@aol.com")
        OlMail.Recipients.Add ToRecipient
    Next ToRecipient

    For Each CcRecipient In Array("jon.doe@aol.com")
        With OlMail.Recipients.Add(CcRecipient)
          .Type = olcc
        End With
    Next CcRecipient

    'Fill in Subject field
    OlMail.Subject = "Open Payable Receivable"


    'Add the report as an attachment
    OlMail.Attachments.Add "C:\temp\test1.xlsx"
    OlMail.Display ' <--for testing, to send use OlMail.Send

    'OlMail.Send
 End Sub

添加多个抄送收件人 In Array("jon.doe@aol.com","jon.doe@aol.com")