Emailing an Excel sheet as a PDF directly

Question

My aim is to be able to click a button and for my Excel sheet to PDF a range of my spreadsheet and to email this to an email address which is in one of the cells in the sheet. For starters, I have the code which can turn a range of cells into a PDF file and allows me to save it:

Option Explicit
Sub savePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String

Set wSheet = ActiveSheet
sFile = Replace(Replace(Range("D11"), " ", ""), ".", "_") _
        & "_" _
        & Range("H11") _
        & ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile

With Excel.Application.FileDialog(msoFileDialogSaveAs)

Dim i As Integer
For i = 1 To .Filters.Count
    If InStr(.Filters(i).Extensions, "pdf") <> 0 Then Exit For
Next i

.FilterIndex = i
.InitialFileName = sFile

.Show
If .SelectedItems.Count > 0 Then vFile = .SelectedItems.Item(.SelectedItems.Count)

End With

If vFile <> "False" Then
wSheet.Range("A1:BF47").ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=vFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

End If
End Sub

Can anybody manipulate this code (attached to a button) so it will email an email address, which is in a particular cell, when the button is clicked and as an added bonus, have the subject of the email work from a cell in the spreadsheet too?

Answer 1

I have a solution which is below. After I set my print area by going into page payout and then set print area, I successfully managed to email the excel sheet as a PDF file:

Sub savePDFandEmail()

Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object

strPath = Environ$("temp") & "\"  trailing "\"

strFName = ActiveWorkbook.Name
strFName = Left(strFName, InStrRev(strFName, ".") - 1) & "_" & ActiveSheet.Name & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    strPath & strFName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

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

On Error Resume Next
With OutMail
    .to = Range("CB4")
    .CC = Range("CB6")
    .BCC = ""
    .Subject = Range("CB8")
    .Body = Range("BW11") & vbCr
    .Attachments.Add strPath & strFName
    '.Display    'Uncomment Display and comment .send to bring up an email window before sending
    .Send        'Keep this the same if you want to send the email address out on click of the button
End With

Kill strPath & strFName
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

I also needed to put a little emailing tool into my sheet too which looks like this:

Clicking the button will now send the email with the PDF file attached.