PDF In-Depth

IAC - Converting Word docs to PDF

April 11, 2001

Advertisement
Advertisement
 

How to convert a folder full of Word docs to PDF.

This code sample is posted here for the general benefit of the PDF development community. Attribution and usage guidelines are as noted in the code source; please respect the wishes of the author when using this code.


Option Explicit
' Author : Karl De Abrew
' Company : Planet PDF
' Date : 24 February 1999
' URL : http://www.planetpdf.com/
' Version : 1.0
' Description: This is a simple demonstration of how all Word
' files in a given folder can be converted to PDFs. The
' Distiller Assistant printer must be configured and operational
' for this to work. No bookmarks or hyperlinks are added - just
plain
' old vanilla PDF. You'll also notice that the printername is
hardcoded.
' It would be a good idea to have this set as a variable.
' Use this as you see fit.
' *** Don't forget to reference the Word.8 library in your
project

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////
' WIN 32 API function declarations
Private Declare Sub Sleep Lib "kernel32" (ByVal
dwMilliseconds As Long)
Private Declare Function MoveFile Lib "kernel32" Alias
"MoveFileA" (ByVal lpExistingFileName As String, ByVal
lpNewFileName As String) As Long
Private Declare Function FindFirstFile Lib "kernel32"
Alias "FindFirstFileA" (ByVal lpFileName As String,
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32"
Alias "FindNextFileA" (ByVal hFindFile As Long,
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32"
(ByVal hFindFile As Long) As Long

' Win32 Constant Declarations and other constants
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

' Win32 Type Declarations
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////

Private m_strError As String

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////

Function GetLastError() As String
GetLastError = m_strError
m_strError = ""
End Function

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////

Function ConvertFile(strSourceFileName As String,
strDestinationFileName As String) As String
On Error GoTo ErrorHandler

Dim msWord As Word.Application
Set msWord = GetObject(Class:="Word.Application.8")

msWord.Visible = True
msWord.ActivePrinter = "Distiller Assistant v3.01"
msWord.Documents.Open strSourceFileName
msWord.ActiveDocument.PrintOut

' Wait for the file to be distilled
While IsFileDistilledYet(msWord.ActiveDocument.Name,
strDestinationFileName) <> True
Sleep 1000
Wend

msWord.ActiveDocument.Close False

' Should check and quit word when done
Set msWord = Nothing
ConvertFile = True
Exit Function

'////////////////////////////////////////////////////
ErrorHandler:
' Create Word for the first time if it is not active
If Err.Number = 429 Then
Set msWord = CreateObject("Word.Application.8")
Err.Clear ' Clear Err object in case error occurred.
Resume
End If

' All other errors handled here
If IsCriticalError Then
ConvertFile = False
Exit Function
Else
Resume
End If
End Function

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////

Private Function IsCriticalError() As Boolean
Dim strErrorMessage As String
Select Case Err.Number ' Evaluate error number.
Case Else
strErrorMessage = "Please contact info@planetpdf.com and
inform them that" & Chr$(13) & _
"the error message reported by the operating system was
" & Chr$(13) & _
Chr$(34) + Trim(Str(Err.Number)) & " " &
Err.Description + Chr$(34)
MsgBox strErrorMessage, , "Conversion error" +
Str(Err.Number)
IsCriticalError = True
Exit Function
End Select
IsCriticalError = False
End Function

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////

Function IsFileDistilledYet(strFileName As String,
strOrigFileName) As Boolean
Dim FindData As WIN32_FIND_DATA
Dim strOutputFileName As String
Dim strDestFileName As String
Dim strFindFileName As String
Dim StrLen As Integer

strOutputFileName = LCase("c:\" + Left(strFileName,
Len(strFileName) - 3) + "pdf")

' Check to see that the file has been created
FindFirstFile strOutputFileName, FindData
StrLen = InStr(FindData.cFileName, Chr(0))
strFindFileName = LCase("c:\" +
Left(FindData.cFileName, StrLen - 1))

If strOutputFileName = strFindFileName Then
IsFileDistilledYet = True
' Build the destination filename from the orginal source document
filename
strDestFileName = Left(strOrigFileName, Len(strOrigFileName) - 3)
+ "pdf"
' Move the distilled file to it's original location
MoveFile strFindFileName, strDestFileName ' SHOULD CHECK FOR
ERRORS HERE
Else
IsFileDistilledYet = False
End If

End Function

'///////////////////////////////////////////////////
'///////////////////////////////////////////////////

Private Sub Command1_Click()
Dim strFileToConvert As String
Dim strDestinationFile As String
Dim strFolder As String

' Set the source folder
strFolder = "c:\temp\"

' Grab the first file to convert
strFileToConvert = Dir(strFolder + "*.doc")

' Loop through all word files
While strFileToConvert <> ""
' Create the destination filename
strDestinationFile = Left(strFileToConvert, Len(strFileToConvert)
- 4)
strDestinationFile = strDestinationFile + ".pdf"

' Attempt to convert the file to PDF
If (ConvertFile(strFolder + strFileToConvert, strFolder +
strDestinationFile) = False) Then
' Hmmm, looks like something went wrong - let's prompt the user
to see if they wish to quit
If (MsgBox("There has been a problem converting the file
" + strFileToConvert, vbYesNo) = vbYes) Then
' Finish up - let's get out of here
Exit Sub
End If
End If

' Grab the next file
strFileToConvert = Dir
Wend

End Sub
PDF In-Depth Free Product Trials Ubiquitous PDF

Debenu Quick PDF Library

Get products to market faster with this amazing PDF developer SDK. Over 900 functions and an equally...

Download free demo

Back to the past, 15 years ago! Open Publish 2002

Looking back to 2002, it's amazing how much of the prediction became a reality. Take a read and see what you think!

September 14, 2017
Platinum Sponsor





Search Planet PDF
more searching options...
Planet PDF Newsletter
Most Popular Articles
Featured Product

Debenu PDF Aerialist

The ultimate plug-in for Adobe Acrobat. Advanced splitting, merging, stamping, bookmarking, and link control. Take Acrobat to the next level.

Features

Adding a PDF Stamp Comment

OK, so you want to stamp your document. Maybe you need to give reviewers some advice about the document's status or sensitivity. This tip from author Ted Padova demonstrates how to add stamps with the Stamp Tool along with related comments.