PDF In-Depth

IAC - Converting Excel files to PDF

February 18, 1999

Advertisement
Advertisement
 

How to convert a folder full of Excel files 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.


' Author : Karl De Abrew
' Company : Planet PDF
' Date : 12 February 1999
' URL : http://www.planetpdf.com/
' Version : 1.0
' Description: This is a simple demonstration of how all Excel 
' 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 Excel.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 msExcel As Excel.Application
    Set msExcel = GetObject(Class:="Excel.Application.8")
       
    msExcel.Visible = True
    msExcel.Workbooks.Open strSourceFileName, UpdateLinks:=False ', ReadOnly:=True
    msExcel.ActiveWorkbook.PrintOut ActivePrinter:="Distiller Assistant v3.01"
 
' Wait for the file to be distilled
    While IsFileDistilledYet(msExcel.ActiveWorkbook.Name, 
strDestinationFileName) <> True
        Sleep 1000
    Wend

    msExcel.ActiveWorkbook.Close False

    ' Should check and quit excel when done
    Set msExcel = Nothing
    ConvertFile = True
    Exit Function

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

ErrorHandler:
' Create Excel for the first time if it is not active
    If Err.Number = 429 Then
        Set msExcel = CreateObject("Excel.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 + "*.xls")

' Loop through all excel 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

Two Passwords Are Better Than One: The Low-Down On PDF Security

For people who don't spend their time looking at PDF files in text editors*, PDF security is a sometimes misunderstood beast.

For example, those document restrictions that PDF files sometimes have -- no Printing, Content Copying, Page Extraction, etc -- are essentially useless unless the PDF also has a User Password.

January 09, 2014
Platinum Sponsor



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

Debenu PDF Aerialist 11

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.