如何使用Excel VBA在电子邮件中添加附件

Question

我有以下代码，但它不能正常工作。我对VBA还比较新。代码可以用来填充电子邮件模板，但是一旦我添加.Attachment.Add，它就无法工作。

Sub CreateMail()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
    Set rngTo = .Range("E2")
    Set rngSubject = .Range("E3")
    Set rngBody = .Range("E4")
    .Attachments.Add "Z:\PHS 340B\Letters of Non-Compliance\..Resources\W9 Form\VPNA W-9 01 09 2017"
End With

With objMail
    .to = rngTo.Value
    .Subject = rngSubject.Value
    .Body = rngBody.Value
    .Display 'Instead of .Display, you can use .Send to send the email _
                or .Save to save a copy in the drafts folder
End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing

End Sub

- Twinkievizzio11

---

你确定路径正确吗？ - Vais

是的，我直接从共享网络驱动器上复制的。 - Twinkievizzio11

错误提示为：“对象不支持此属性或方法”。 - Twinkievizzio11

Answer 1

试试这个：

Sub emailtest()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
Set rngTo = .Range("E2")
Set rngSubject = .Range("E3")
Set rngBody = .Range("E4")
End With

With objMail
.To = rngTo.Value
.Subject = rngSubject.Value
.Body = rngBody.Value
.Attachments.Add "Z:\PHS 340B\Letters of Non-Compliance\..Resources\W9 Form\VPNA W-9 01 09 2017"
.Display 'Instead of .Display, you can use .Send to send the email _
            or .Save to save a copy in the drafts folder
End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing

End Sub

在使用Outlook而不是Excel时，您需要使用.Attachments.Add。

- Ziggus

---

这是什么意思？我正在使用Outlook创建电子邮件，它运行良好，只有当我尝试添加附件时才出问题。 - Twinkievizzio11

附件是一个 .pdf 文件。 - Twinkievizzio11

@Twinkievizzio11 请尝试按照我发布的代码进行复制和粘贴，当我测试时它是有效的。你在“With Activesheet”中使用了Attachments.Add，你需要将其放在“With objMail”下面。 - Ziggus

非常感谢！完美地运作了。你是最棒的！ - Twinkievizzio11

@Twinkievizzio11，请确保将Ziggus的答案标记为已接受。只需在他的帖子下方的向下箭头旁边点击复选标记即可。此外，我想补充一下，这个方法之所以有效是因为您错误地将附件添加到了代码的错误区域。对象“ActiveSheet”不支持“.Attachments.Add”，因此它需要移动到“With objMail”区域。这只是对任何仍然感到困惑的人的一点澄清。 - TotsieMae

Answer 2

这个简单的脚本应该说明如何添加附件到一封电子邮件中，然后发送这封邮件。

Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .to = "[e-mail]"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

https://www.rondebruin.nl/win/s1/outlook/amail1.htm

- ASH