Hi,
I am using some code that Ken Puls originally wrote. I am running a program from Excel, placing data into word and then creating a pdf using pdfcreator. It seems to be creating the PDF correctly, but for some reason seems to be won't release the loop at the end. Even though the file is there and the only way it seem I can get out of the loop is by placing a msg box.
I was wondering if someone knew how to break the code and what exactly I am doing wrong to allow the program to continue and let the remaining files to autosave.
Thanks in advance!
[vba]
'Author : Ken Puls
'Macro Purpose: Print active Word documents to PDF (filename of document)
'
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for early bind, set reference to PDFCreator
Private Function WordToPDF(ByRef Wordapp As Object) As Boolean
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim sPrinter As String
Dim sMasterPass As String
Dim lDocs As Long
Dim bRestart As Boolean
Dim bBkgrndPrnt As Boolean
Dim mytime As Long
Dim Cell1
Dim TodayDate As String
Cell1 = Worksheets("Sheet1").Range("C10")
TodayDate = Format(Date, "yyyy.mm.dd")
On Error GoTo EarlyExit
With Wordapp
sPrinter = CStr(.ActivePrinter)
.ActivePrinter = "PDFCreator"
bBkgrndPrnt = .Options.PrintBackground
.Options.PrintBackground = False
.ScreenUpdating = False
End With
sPDFName = Cell1 & "_" & TodayDate & ".pdf"
sPDFPath = ThisWorkbook.Path & "\FirstDir" & "\" & Cell1 & "_" & TodayDate & "\"
sMasterPass = "****"
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
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
'Set Security
.cOption("PDFUseSecurity") = 1
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = sMasterPass
'Set Individual security
.cOption("PDFDisallowCopy") = 1
.cOption("PDFDisallowModifyContents") = 1
.cOption("PDFDisallowPrinting") = 0
.cOption("PDFDisallowModifyAnnotations") = 1
.cOption("PDFAllowAssembly") = 0
.cOption("PDFAllowFillIn") = 0
.cOption("PDFAllowScreenReaders") = 0
.cOption("PDFAllowDegradedPrinting") = 0
.cOption("PDFHighEncryption") = 1
.cClearCache
End With
Wordapp.ActiveDocument.PrintOut copies:=1
'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = lDocs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.cCombineAll
.cPrinterStop = False
End With
'Wait until the file shows up before closing PDF Creator
Do
DoEvents
Loop Until Dir(sPDFPath & sPDFName) = sPDFName
'MsgBox "Complete.", vbInformation, sPDFName
Cleanup:
'Release objects and terminate PDFCreator
pdfjob.cClose
Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
'Reset all application settings to user's original settings
With Wordapp
.ScreenUpdating = True
.ActivePrinter = sPrinter
.Options.PrintBackground = bBkgrndPrnt
End With
Exit Function
EarlyExit:
If WrnMsg = "" Then WrnMsg = "Cannot create PDF"
Resume Cleanup
End Function
[/vba]
Reply With Quote
