This is a problem, that I was faced with a number of times over the last few years, and originally, I’d written/borrowed a whole bunch of code that used Adobe PDF to do this, but being at an organisation where your software is centrally ‘managed’ meant that I went to do this one day, and Adobe had been uninstalled. To get it reinstalled would take a minimum of 3 days, and I needed to PDF ~400 files that day. So, given I had PDF creator, the search began for a script that could use it. This is that script.
Thanks to Ken Puls (www.excelguru.ca) for the key bits of code here.
This script is a really good starting point. In this case, I wanted to convert a whole directory of word documents into PDF. The reason I wasn’t using Word’s built in model, is that the fonts were setup unusually, and when PDF’d via word, the incorrect fonts were embedded, however when using PDF printer, everything looked Fiiiine.
Firstly, you need to setup references, and pull in the references for PDFCreator. Secondly, you’ll need to create a directory underneath the working directory called 1_PDF Saved. I’ll admit, this was thrown together in a hurry to solve an immediate problem. So any poor practice / lack of comments /notation/documentation, etc. is entirely normal.
Sub PrintToPDF_Early() ' Used while Adobe PDF has been uninstalled from my FRICKEN COMPUTER!! Dim pdfjob As PDFCreator.clsPDFCreator Dim sPDFName As String Dim sPDFPath As String Dim myDoc As word.Document Dim word As word.Application Dim fso, fpath, folder, fnames Dim potDoc As Variant 'potential document Set word = New word.Application word.Visible = True Set fso = CreateObject("Scripting.FileSystemObject") fpath = ActiveWorkbook.Path & "\1_PDF Saved\" 'make sure this directory exists Set folder = fso.GetFolder(fpath) Set fnames = folder.Files yPos = 2 For Each potDoc In fnames 'the below line is used if you want to restrict to the right document type, etc. ' If Left(potDoc.Name, 2) <> "~$" And Left(potDoc.Name, 2) <> "1_" And Right(potDoc.Name, 3) <> "pdf" Then Set myDoc = word.Documents.Open(potDoc.Path, False, True, False) 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") = myDoc.Path .cOption("AutosaveFilename") = Replace(replaceShit(myDoc.Name), ".docx", ".pdf") .cOption("AutosaveFormat") = 0 ' 0 = PDF .cClearCache End With 'Print the document to PDF word.Application.ActivePrinter = "PDFCreator on Ne01:" word.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 myDoc.Close (False) Set myDoc = Nothing Next End Sub Public Function replaceShit(textString As String) 'this is a pretty simple macro to replace shitty strings that are unlikely to save in a filename. Dim charArray As Variant Dim repArray As Variant Dim x As Integer charArray = Array("/", "\", " ", ",", "&") repArray = Array("_", "_", "_", "_", "and") For x = 0 To UBound(charArray) textString = Replace(textString, charArray(x), repArray(x)) Next replaceShit = textString End Function