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

Question

我希望能够从Excel中通过Outlook发送报告。

我正在使用自己和同事的电子邮件地址进行测试。我收到了一个“无法投递”的错误。

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

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("[e-mail]")
    OlMail.Recipients.Add ToRecipient
Next ToRecipient

For Each CcRecipient In Array("[e-mail]")
    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

- Michael

---

Excel VBA 不知道 olCC 的值。如果你让 Outlook 应用程序可见，并注释掉发送行，你可能更容易地找出问题所在。 - Tim Williams

如果您正在使用后期绑定，命名常量的数值分别为olMailItem=0，olTo=1，olCC=2。请使用数值而不是命名常量。 - ChipsLetten

@TimWilliams，ChipsLetten - 非常感谢你们的见解，我很抱歉，这是我第一次在OutLook中使用VBA，我不太确定如何将数字值编入代码。在将Const olTo = 1写入代码后，这个1会在代码中稍后使用吗？ - Michael

在您现有的代码中，您将 Outlook 常量替换为数字，因此对于 .Type = olCC，您将其更改为 .Type = 2 'olCC 的值。我通常会在行末添加注释，以便提醒自己/他人数字 2 代表什么。 - ChipsLetten

@ChipsLetten 好的，我明白你的意思了。我将其更改为数字值，现在CC部分可以正常工作了！非常感谢您的见解，如果您发布正式答案，我很乐意将点赞授予给您和Tim回答我的问题。 - Michael

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("[e-mail]")
        OlMail.Recipients.Add ToRecipient
    Next ToRecipient

    For Each CcRecipient In Array("[e-mail]")
        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("[e-mail]","[e-mail]")

- 0m3r

Answer 2

Sub AUTOGENERATEEMAIL()

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strBody = "<FONT SIZE = 3>Good day all, " & "<br>" & "<br>" & "Please see attached." & "<br>" & "<br>" & "Pleasant Regards"

With OutMail
    .Display
    .To = "[e-mail]; [e-mail]; [e-mail]; "
    .CC = ""
    .BCC = ""
    .Subject = "Finance" & path
    .HTMLBody = strBody & .HTMLBody
    .Attachments.Add ("\\Finance\Company Shared Folders\UserShares\Finance Tool\Finance Assistant Tools\Finance.xlsb")
    .Display

End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

- L J

---

欢迎来到Stack Overflow！虽然这段代码可能解决了问题，但是包括解释它如何以及为什么解决了问题将有助于提高您的帖子质量，并可能导致更多的赞。请记住，您正在回答未来读者的问题，而不仅仅是现在提问的人。请[编辑]您的答案以添加解释并指出适用的限制和假设。来自审核 - double-beep