Printing to PDFCreator using VBA

[rrenis]

Hi - thanks for looking at this post! I have the following code which with a couple of tweaks works fine in excel but when I run this in word it hangs at the point where it is spooling. I'm using PDF Creator 0.9.3.

Can anyone see anything obvious that's wrong with the following code? :think:

Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * 260
End Type
Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

' ## THE FOLLOWING TERMINATES PDFCREATOR IS ALREADY RUNNING ##

Public Sub KillProcess(NameProcess As String)

Const PROCESS_ALL_ACCESS = &H1F0FFF
Const TH32CS_SNAPPROCESS As Long = 2&
Dim uProcess As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExename As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
Dim WinDirEnv As String

If NameProcess <> "" Then
AppCount = 0
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
RProcessFound = ProcessFirst(hSnapshot, uProcess)
Do
i = InStr(1, uProcess.szexeFile, Chr(0))
SzExename = LCase$(Left$(uProcess.szexeFile, i - 1))
WinDirEnv = Environ("Windir") + "\"
WinDirEnv = LCase$(WinDirEnv)
If Right$(SzExename, Len(NameProcess)) = LCase$(NameProcess) Then
AppCount = AppCount + 1
MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
AppKill = TerminateProcess(MyProcess, ExitCode)
Call CloseHandle(MyProcess)
End If
RProcessFound = ProcessNext(hSnapshot, uProcess)
Loop While RProcessFound
Call CloseHandle(hSnapshot)
End If
End Sub

'## THIS IS THE CODE TO PRINT TO PDF ##

Sub PDF_Print()

On Error GoTo ErrorMessage
Dim pdfjob As Object

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then KillProcess (PDFCreator.exe) Else

.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = "c:\"
.cOption("AutosaveFilename") = "test"
.cOption("AutosaveFormat") = 0
.cClearCache
End With

ActivePrinter = "PDFCreator"
ActiveDocument.PrintOut

Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

Do Until Dir("c:\test.pdf") <> ""
DoEvents
Loop
pdfjob.cClose

Set pdfjob = Nothing

End Sub

Cheers,
rrenis

[mdmackillop]

Dump all that and try

Sub PDF_Print()
Dim p
p = ActivePrinter
ActivePrinter = "PDFCreator"
ActiveDocument.PrintOut
ActivePrinter = p
End Sub

[rrenis]

Thanks mdmackillop - that works a treat, but do you think it is possible to specify the location and filename to save it in (With pdfjob in the previous code) or is this maybe where the previous code was causing me problems? Looking at the previous code it is the following process that causes the spooling to hang...

Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

Do Until Dir("c:\test.pdf") <> ""
DoEvents
Loop
pdfjob.cClose

Cheers,
rrenis

[mdmackillop]

Are you looking to hard code either the path or the document name, or how are these obtained?

[rrenis]

Hi mdmackillop - I'm planning to throw up a userform where I can browse to a project folder on the server (rather than the default My Documents) and name the file in a textbox (or populate the textbox automatically on userform intialize if the Word Document has already been named and saved). I've just about finished that and am planning to use Global Strings for the path and filename to be used in the final PDF code. So they won't be hard coded but instead be based on strings. Hope this is actually possible as so far even using your code I can't seem to incorporate saving the PDF to a specific location - although it's acheivable in excel... :doh:

Cheers,
rrenis

[rrenis]

Hi - despite messing with this over the weekend I still can't seem to progress the word to PDF aspect of the code. I was thinking about just using the code supplied by mdmackillop as at least this creates a PDF in the default location but then move it out of the default location and into the location specified in the global string and rename it based upon the global string (obtained from a userform listbox and textbox respectively).

The problem is I'm not too sure how to grab the correct PDF as there will be a few PDF's in the default location (My Documents). Does anyone know of a way finding the latest PDF created in a directory?? :dunno

Cheers,
rrenis

[mdmackillop]

Note the requirement foe reference to PDFCreator
Sub PrintToPDF_Early()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for early bind, set reference to PDFCreator

Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String

'/// Change the output file name here! ///
sPDFName = "testPDF.pdf"
sPDFPath = ActiveDocument.Path & Application.PathSeparator


Set pdfjob = New PDFCreator.clsPDFCreator

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
Application.ActivePrinter = "PDFCreator1"
ActiveDocument.PrintOut

'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 Sub

[rrenis]

Hi mdmackillop :hi: Thanks very much for that - I'll give it a try!

cheers,
rrenis