' Put the below code into the module of userform
' with CheckBox1 ... CheckBox4 and CommandButton1
Private Sub CommandButton1_Click()
Dim MySheets As String
' --> Use names of the real sheets instead of the below "Sheet1", ... ,"Sheet4"
If CheckBox1 Then MySheets = "Sheet1"
If CheckBox2 Then MySheets = MySheets & ",Sheet2"
If CheckBox3 Then MySheets = MySheets & ",Sheet3"
If CheckBox4 Then MySheets = MySheets & ",Sheet4"
' <--
' Select sheets to be exported to the PDF file
If Left(MySheets, 1) = "," Then MySheets = Mid(MySheets, 2)
ActiveWorkbook.Sheets(Split(MySheets, ",")).Select
' Email as PDF the selected sheets
Call AttachActiveSheetPDF_04
' Close the form
Unload Me
End Sub
Sub AttachActiveSheetPDF_04()
' This sends email with attached PDF file of the selected sheets
Dim IsCreated As Boolean
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim i As Long
Dim Char As Variant, Attachment As Variant
' Change to suit
Title = "Empire-Cat Rental Equpment Quote"
' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
For Each Char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, Char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
' Delete PDF file - for the case it was not deleted at debugging
If Len(Dir(PdfFile)) Then Kill PdfFile
' Export the selected sheets of workbook as PDF to the temporary folder
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Title
'.To = TextBox4.Value ' Email(s) of the main recipient(s)
'.CC = TextBox1.Value ' Email(s) of 'copy to' recipient(s) (CC = "Carbon Copy")
'.BCC = TextBox9.Value ' Email(s) of hidden recipient(s) (BCC = "Blind Carbon Copy")
.Body = "Dear Customer," & vbLf & vbLf _
& Title & " is attached in PDF file" & vbLf & vbLf _
& "Best Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
' Add other attachments here
'For Each Attachment In Split(TextBox3.Value, ";")
' If Trim(Attachment) <> "" Then .Attachments.Add Trim(Attachment)
'Next
' Try to send
On Error Resume Next
.Send ' or use .Display
' Return focus to Excel's window
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
' Delete the temporary PDF file
If Len(Dir(PdfFile)) Then Kill PdfFile
' Try to quit Outlook if it was not previously open
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
' Note: sometimes Outlook object can't be released from the memory
Set OutlApp = Nothing
End Sub