Creating email with saved PDF file

[lfran]

Hi!

I am using this VBA from MrExcel for saving an excel file and a pdf file and it works great! Now, I would like to generate an email with only the PDF file attached.

Here is the VBA from MrExcel....

Sub SaveInvoiceBothWaysAndClear()
Dim NewFN As Variant
' Create the PDF First
NewFN = "C:\aaa\PDFInvoices\Inv" & Range("E5").Value & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
' Next, Save the Excel File
ActiveSheet.Copy
NewFN = "C:\aaa\Inv" & Range("E5").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
' Increment the invoice number
Range("E5").Value = Range("E5").Value + 1
' Clear out the invoice fields
Range("A20:E39").ClearContents
End Sub

First question is can I just add the code in this or do I start a new Sub?

Thanks!

 

[mumps]

Try:

Sub SaveInvoiceBothWaysAndClear()
    Application.ScreenUpdating = False
    Dim NewFN As Variant, OutApp As Object, OutMail As Object
    ' Create the PDF First
    NewFN = "C:\aaa\PDFInvoices\Inv" & Range("E5").Value & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=False
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = ""
        .Subject = ""
        .HTMLBody = ""
        .attachments.Add "C:\aaa\PDFInvoices\Inv" & Range("E5").Value & ".pdf"
        .Display
    End With
    ' Next, Save the Excel File
    ActiveSheet.Copy
    NewFN = "C:\aaa\Inv" & Range("E5").Value & ".xlsx"
    ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    ' Increment the invoice number
    Range("E5").Value = Range("E5").Value + 1
    ' Clear out the invoice fields
    Range("A20:E39").ClearContents
    Application.ScreenUpdating = True
End Sub