Option Explicit



Sub Distiller_Convert_Doc2PDF()



'This will convert multiple MS Word documents to PDF files - reliably!


'Code for Acrobat 5 - Distiller


'Must change printing preferences for Distiller printer:

'Adobe PDF Settings - un-check the box "do not send fonts to Distiller"

'This can't work unless you DO send the fonts


'Must Set references

'to Acrodist.exe

'and Acrobat.tlb    Adobe Acrobat XX type Library

'and Microsoft Word object library


Dim loWord      As Word.Application


'System default printer

Dim lsPrinter   As String


Dim MyPathFrom  As String

Dim MyPathTO    As String

Dim MyCount     As String

Dim MyFileName  As String


Dim strFullName As String

Dim strPDFName  As String

Dim blnSuccessfull As Boolean


'Create instance of Distiller printer

Dim objDistiller As PdfDistiller

Set objDistiller = New PdfDistiller


'Create instance of Word

Set loWord = New Word.Application


'After this statement, you'll see the Word document instance

loWord.Visible = True


MyCount = 0

MyPathFrom = "E:\TV\"

MyPathTO = "E:\TV\PDF\"


'Get the default system printer

lsPrinter = loWord.ActivePrinter


MyFileName = Dir(MyPathFrom, vbDirectory)


Do While MyFileName <> ""

    If MyFileName <> "." And MyFileName <> ".." Then

        If (GetAttr(MyPathFrom & MyFileName) And vbNormal) = vbNormal Then

            If LCase(Right(MyFileName, 3)) = "doc" Or LCase(Right(MyFileName, 3)) = "xls" Then

                MyCount = MyCount + 1


                'Set up name of Word document and open it

                strFullName = MyPathFrom & MyFileName

                loWord.Documents.Open FileName:=strFullName


                'Set up names of PDF and Postscript files


                'NOTE - need different destination directory to avoid error

                'Dir function gets confused when .ps files are deleted!

                strFullName = MyPathTO & MyFileName

                strFullName = Mid$(strFullName, 1, InStr(1, strFullName, ".") - 1) & ".pdf"

                strPDFName = strFullName

                strFullName = Mid$(strFullName, 1, InStr(1, strFullName, ".") - 1) & ".ps"


                ' For Acrobat 5

                loWord.ActivePrinter = "Acrobat Distiller"

                ' For Acrobat 7

                'loWord.ActivePrinter = "Adobe PDF"


                loWord.Options.DefaultFilePath(wdDocumentsPath) = MyPathTO


                'Two step process does NOT show dialog box

                loWord.PrintOut FileName:="", Range:=wdPrintAllDocument, _

                    Item:=wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _

                    Collate:=True, Background:=False, PrintToFile:= _

                    True, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _

                    PrintZoomPaperHeight:=0, OutputFileName:=strFullName, Append:=False


                ' For Acrobat 5

                blnSuccessfull = objDistiller.FileToPDF(strFullName, strPDFName, "Print")

                ' For Acrobat 7

                'blnSuccessfull = objDistiller.FileToPDF(strFullName, strPDFName, "Standard")




                'Acrobat Distiller leaves .ps file behind

                Kill strFullName


            End If

        End If

    End If


    MyFileName = Dir



MsgBox MyCount & " have been converted."


'Reset system printer

loWord.ActivePrinter = lsPrinter


'Now we can close the Word application entirely


Set loWord = Nothing



End Sub