Ken,
I'm working on a project to print selected worksheets to a pdf and then email it out automatically. I'm having issue with the code and thought that this might help, but it kept giving me an error. I need the code to send the pdf as soon as it is published. Maybe you can look at the code and give me some pointers. I think you may have worked on this in the past.
I'm working on a project to print selected worksheets to a pdf and then email it out automatically. I'm having issue with the code and thought that this might help, but it kept giving me an error. I need the code to send the pdf as soon as it is published. Maybe you can look at the code and give me some pointers. I think you may have worked on this in the past.
Code:
' Print Multiple Worksheets to a Single PDF File:
Sub PrintToPDF_MultiSheetToOne_Early()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
'/// Change the output file name here! ///
sPDFName = "Consolidated.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator
'Make sure the PDF printer can start
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "Error!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
' lTtlSheets = Application.Sheets.Count
'For lSheet = 1 To Application.Sheets.Count
' On Error Resume Next 'To deal with chart sheets
' If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
' Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Else
' lTtlSheets = lTtlSheets - 1
'End If
' On Error GoTo 0
' Next lSheet
'Print the document to PDF
lTtlSheets = frmPrinttoPDF.lstProcess.ListCount - 1
For lSheet = 0 To frmPrinttoPDF.lstProcess.ListCount - 1
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Application.Sheets(frmPrinttoPDF.lstProcess.List(lSheet)).UsedRange) Then
If Not frmPrinttoPDF.CheckBox1.Value = True Then pdfjob.cOption("AutosaveFilename") = sPDFName & "Sheetname" ' This should be the worksheet name
Application.Sheets(frmPrinttoPDF.lstProcess.List(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo 0
Next lSheet
'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
' With pdfjob
' .cCombineAll
' .cPrinterStop = False
'End With
With pdfjob
If frmPrinttoPDF.CheckBox1.Value = True Then .cCombineAll
.cPrinterStop = False
End With
'Wait until the PDF file shows up then release the objects
Do Until Dir(sPDFPath & sPDFName) <> ""
DoEvents
Loop
'Send PDF as Email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "test@test.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.Body = "YYY"
.Attachments.Add sPDFPath & sPDFName
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox ("The PDF has been successfully created as " & sPDFName)
pdfjob.cClose
Sleep 1000
Set pdfjob = Nothing
End Sub