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")

               

                loWord.ActiveDocument.Close

           

                'Acrobat Distiller leaves .ps file behind

                Kill strFullName

           

            End If

        End If

    End If

 

    MyFileName = Dir

 

Loop

MsgBox MyCount & " have been converted."

 

'Reset system printer

loWord.ActivePrinter = lsPrinter

 

'Now we can close the Word application entirely

loWord.Quit

Set loWord = Nothing

 

 

End Sub