I am completely new to VBA and dont have the slightest idea how it works. I need to create a PDF from an Excel 2003 worksheet and send it automatically by email as attachment.
Thanks to this site and to Ken Puls, I managed to find a macro to create PDF using PDFCreator which works absolutely fine. I have also found code to send emails. Can somebody help me to join them into one macro please?
Below are the codes:
The following is the code to send email:
Thanks to this site and to Ken Puls, I managed to find a macro to create PDF using PDFCreator which works absolutely fine. I have also found code to send emails. Can somebody help me to join them into one macro please?
Below are the codes:
Code:
Sub PrintToPDF_Early()
'Author : Ken Puls ()
'Macro Purpose: Print to PDF file using PDFCreator
' Designed for early bind, set reference to PDFCreator
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim bRestart As Boolean
'/// Change the output file name here! ///
sPDFName = "testPDF.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'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
Set pdfjob = New PDFCreator.clsPDFCreator
'Check if PDFCreator is already running and attempt to kill the process if so
Do
bRestart = False
Set pdfjob = New PDFCreator.clsPDFCreator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
'PDF Creator is already running. Kill the existing process
Shell "taskkill /f /im PDFCreator.exe", vbHide
DoEvents
Set pdfjob = Nothing
bRestart = True
End If
Loop Until bRestart = False
'Assign settings for PDF job
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'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
Cleanup:
'Release objects and terminate PDFCreator
Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
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
The following is the code to send email:
Code:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs sPDFPath & sPDFName
On Error Resume Next
With OutMail
.To = Cells(4, 2)
.Subject = "TIL Record Sheet"
.Body = "Dear " & Cells(4, 4) & "," & vbNewLine & _
"" & vbNewLine & _
"Attached please find copy of your TIL record sheet." & vbNewLine & _
"" & vbNewLine & _
"Regards," & vbNewLine & _
"" & vbNewLine & _
"HR Office" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"THIS IS A COMPUTER GENERATED MESSAGE. PLEASE CALL ON 1641 IF YOU DISAGREE WITH CONTENTS."
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill sPDFPath & sPDFName
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End Sub