Excel VBA – Create a PDF and email it

Before deciding to create a PDF from your worksheet and emailing it, it should be noted that this code is specifically for Windows versions of Excel 2007 onwards and only when Outlook is your email client.

It consists of 2 pieces of VBA code although one is more commonly described as a UDF (User Defined Function) -The first one.

datanology notes (more commentary required)



Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _ OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
'Function Code required to send email through Outlook - Both functions needed
Dim FileFormatstr As String
Dim Fname As Variant
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
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 = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
End Sub


Public Sub Sending_the_email()
'2nd part of email VBA
Dim FileName As String
NJB3 = Replace(Now(), "/", " ")
NJB = Replace(NJB3, ":", "")
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"be aware that every selected sheet will be published"
End If
'Saves the quote as a file
FileName = RDB_Create_PDF(Sheets("PDF"), "C:\Users\nhkb\QUOTE- " & NJB & ".pdf", True, False)
'Replace the subject, body and signoff at end of email here.
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "", "This is the subject", _
"Body of email" _
& vbNewLine & vbNewLine & "End of email text", False
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End Sub


Contact us for some advice and guidance on how your Excel development could be created and start helping your business straight away. Contact Us

Datanology