C
Corey
I am trying to have a macro to send a range on 1 sheet as a PDF attachment
via vba.
I have 1 code that uses pdf factory to create the pdf, and another that uses
a free pdfcreator.
Both seem to require some user inputs still as follows:
The 2nd code will add the To and Cc email addresses and subject line etc,
but does not Save the pdf name with VBA.
.. Naming of the pdf
.. Save pdf file path
.. Delete pdf afterwards (optional)
..
I am trying to achieve these user options to be done by the VBA, is it
possible?
Codes below:
~~~~~~~~~~~~~~~~~~~~~~~~~
Sub PrinttaPDF_Late()
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
sPDFName = "testPDF.pdf" ' <== Doesa not call the pdf this !!!
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator ' <=== Cannot
seem to modify this to my server folder required
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", 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.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 PDF file shows up then release the objects
Do Until Dir(sPDFPath & sPDFName) <> ""
DoEvents
Loop
pdfjob.cClose ' <=== Does not close and send attachment via code ??
Set pdfjob = Nothing
End Sub
~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~
Sub Sendpdf()
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheet1.Range("B13").Value
.CC = Sheet1.Range("B15").Value
.BCC = ""
.Subject = Sheet1.Range("B63").Value
.Body = Sheet1.Range("B65").Value
If Not FileExists("\\SERVER\\Sheets\Pdf's\" &
Range("G5").Value & ".pdf") Then
MsgBox "The pdf file doesn't exist! " & "Please check
the pdf File Name you just saved" & vbCrLf & vbCrLf & "It MUST be saved as
" & Sheet1.Range("G5").Value & " ONLY!", vbCritical, "...."
Exit Sub
Else
.Attachments.Add ("\\SERVER\Server\Sheets\Pdf's\" &
Range("G5").Value & ".pdf")
End If
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Sheet1.Range("B64").Value = Time & Date
Sheets("Information").Range("B64").Value =
Format(Sheets("Information").Range("B64").Value, "hh:mmAM/PM dddd dd mmmm
yyyy")
Sheet1.Protect
End Sub
~~~~~~~~~~~~~~~~~~~
via vba.
I have 1 code that uses pdf factory to create the pdf, and another that uses
a free pdfcreator.
Both seem to require some user inputs still as follows:
The 2nd code will add the To and Cc email addresses and subject line etc,
but does not Save the pdf name with VBA.
.. Naming of the pdf
.. Save pdf file path
.. Delete pdf afterwards (optional)
..
I am trying to achieve these user options to be done by the VBA, is it
possible?
Codes below:
~~~~~~~~~~~~~~~~~~~~~~~~~
Sub PrinttaPDF_Late()
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
sPDFName = "testPDF.pdf" ' <== Doesa not call the pdf this !!!
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator ' <=== Cannot
seem to modify this to my server folder required
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", 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.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 PDF file shows up then release the objects
Do Until Dir(sPDFPath & sPDFName) <> ""
DoEvents
Loop
pdfjob.cClose ' <=== Does not close and send attachment via code ??
Set pdfjob = Nothing
End Sub
~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~
Sub Sendpdf()
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheet1.Range("B13").Value
.CC = Sheet1.Range("B15").Value
.BCC = ""
.Subject = Sheet1.Range("B63").Value
.Body = Sheet1.Range("B65").Value
If Not FileExists("\\SERVER\\Sheets\Pdf's\" &
Range("G5").Value & ".pdf") Then
MsgBox "The pdf file doesn't exist! " & "Please check
the pdf File Name you just saved" & vbCrLf & vbCrLf & "It MUST be saved as
" & Sheet1.Range("G5").Value & " ONLY!", vbCritical, "...."
Exit Sub
Else
.Attachments.Add ("\\SERVER\Server\Sheets\Pdf's\" &
Range("G5").Value & ".pdf")
End If
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Sheet1.Range("B64").Value = Time & Date
Sheets("Information").Range("B64").Value =
Format(Sheets("Information").Range("B64").Value, "hh:mmAM/PM dddd dd mmmm
yyyy")
Sheet1.Protect
End Sub
~~~~~~~~~~~~~~~~~~~