Sub PS_1()
'Dim pdfjob As Object
'Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
Dim sPDFName As String
Dim sPDFPath As String
Dim bRestart As Boolean
Dim StrTo As String
Dim StrSubject As String
Dim StrBody As String
Dim Send As Boolean
Dim OutApp As Object
Dim OutMail As Object
'/// Change the output file name here! ///
sPDFName = "XX.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Dim pdfjob As Object
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
'Activate error handling and turn off screen updates
On Error GoTo EarlyExit
Application.ScreenUpdating = False
'Check if PDFCreator is already running and attempt to kill the process if so
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "PDFCreator is Open.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.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
ActiveSheet.PageSetup.PrintArea = "$B$11:$K$27"
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
' pdfjob.cClose
' Set pdfjob = Nothing
'\\\\\ End Saving PDF
'Delete the PDF if it already exists
If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)
'Print the document to PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until the file shows up before closing PDF Creator
Do
DoEvents
Loop Until Dir(sPDFPath & sPDFName) = sPDFName
'/////// Send PDF Invoice in Email
Dim toEmail As String
toEmail = Range("master!c3").Value
tosub = Range("master!b1").Value
toname = Range("master!b3").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = toEmail
.CC = ""
.BCC = ""
.Subject = "PayAdvice for the month of " & tosub
'.Body = "Invoice for blah blah blah"
.Body = "Dear " & toname & vbNewLine & _
"" & vbNewLine & _
"Attached, please find a PayAdvice for the month of " & tosub & vbNewLine & _
"" & vbNewLine & _
"Please Contact Y If You Have any Questions." & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"Thank You !"
.attachments.Add ("C:\Documents and Settings\Muthu\Desktop\XX.pdf")
'.Attachments.Add sPDFPath & "\" & PrevInv
'.Send 'or use .Display
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'//////////// Save PDF
Skipemail:
'/// Close PDF File
pdfjob.cClose
Set pdfjob = Nothing
Cleanup:
'Release objects and terminate PDFCreator
'pdfjob.cClose
'Set pdfjob = Nothing
'Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
'ActiveWorkbook.Save
Application.ScreenUpdating = True
Dim killfile As String
killfile = "C:\Documents and Settings\Muthu\Desktop\XX.pdf"
'çheck that file exists
If Len(Dir$(killfile)) > 0 Then
'first remove readonly attribute, if set
SetAttr killfile, vbNormal
'then delete the file
Kill killfile
End If
Exit Sub
EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered. PDFCreator has" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup
End Sub