How to add an attachment to an email using VBA in

Question

I have the following code but it is not working. I am fairly new to VBA as well. The code works to populate the email template but as soon as I add the .Attachment.Add it does not work.

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

Answer 1

Try this:

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

You need to use the .Attachments.Add when working within Outlook not Excel.

Answer 2

This simple script should illustrate the point of how to add attachments to an email, and then send the email.

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