VBScript to Convert Microsoft Office Files (Word, Excel, PowerPoint) to PDF

I spend a lot of my time working with Word documents and Excel spreadsheets - it’s in the nature of what I do. I frequently found that I need to create PDF copies of these files (to send out to clients) and eventually I grew tired of having to open the files one by one and select to save each as a PDF. As a result I created a bit of VBScript to automatically convert files for me (in Windows).

A shortcut to the script should be placed in your send-to folder to allow you to send files directly to the script. For each file it is passed (and you can pass different types of files at once) the script tries to determine what application to open it with and then opens that file in that application. Once open it saves the file as a PDF (in the same folder as the original file) and then closes the application.

There are a couple of settings that you might wish to amend to suit your own purposes.

  • If the constant SUMMARY_DISPLAY is set to TRUE it will display a window that summarises the files that have been converted. If set to FALSE no confirmation is displayed.
  • The variables g_strFileTypesWord, g_strFileTypesExcel and g_strFileTypesPowerPoint contain lists of file extensions delimited by pipes “|”. These are for Word, Excel and PowerPoint files respectively. You can extend the lists to include other file types (from those presented here) - templates, TXT, RTF, CSV, etc.

There’s nothing in it for handling errors, but obviously feel free to extend this script to meet your own needs. There are a number of constants and settings that I’ve set out to make it easier for you to tweak or amend. Maybe you want to save the files as XPS files or you want to change the final location of all your output files - please customise away :)

I use this script regularly with Microsoft Office 2007 without any issues (so far). Hopefully it’s compatible with Office 2010 (and beyond), so if you do try it with another version of Office why not leave a comment below to let people know if it works or needs a particular amendment to get it to work.

Option Explicit

'---------------------
' CONFIGURATION START
'---------------------
'Display a summary in a message box when the conversions are complete
Const SUMMARY_DISPLAY = TRUE
Const SUMMARY_TITLE = "Conversion Complete"

'File extensions for PDFs
Const PDF_Extension = "pdf"

'Results for CheckFile Function
Const CHECKFILE_OK = 0
Const CHECKFILE_FileDoesNotExist = 1
Const CHECKFILE_NotMSOFile = 2

'Settings to produce PDFs from the applications
Const EXCEL_PDF = 0
Const EXCEL_QualityStandard = 0
Const WORD_PDF = 17
Const POWERPOINT_PDF = 32

'File types returned from OfficeFileType function
Const FILE_TYPE_NotOffice = 0
Const FILE_TYPE_Word = 1
Const FILE_TYPE_Excel = 2
Const FILE_TYPE_PowerPoint = 3

'Valid file type lists
Const FILE_TYPE_DELIMITER = "|"
Dim g_strFileTypesWord
g_strFileTypesWord="|DOC|DOCX|"
Dim g_strFileTypesExcel
g_strFileTypesExcel="|XLS|XLSX|"
Dim g_strFileTypesPowerPoint
g_strFileTypesPowerPoint="|PPT|PPTX|"
'----------------------
' CONFIGURATION FINISH
'----------------------


'Call the main routine
Main
'--------------------
' MAIN ROUTINE START
'--------------------
Sub Main()
    Dim colArgs, intCounter, objFSO, strFilePath
    
    'Get the command line arguments for the script
    ' - Each chould be a file to be processed
    Set colArgs = Wscript.Arguments
    If colArgs.Count > 0 Then
        For intCounter = 0 to colArgs.Count - 1
            strFilePath = Wscript.Arguments(intCounter)
            
            'Check we have a valid file and process it
            Select Case CheckFile(strFilePath)
                Case CHECKFILE_OK
                    Select Case OfficeFileType(strFilePath)
                        Case FILE_TYPE_Word
                            SaveWordAsPDF strFilePath
                            
                        Case FILE_TYPE_Excel
                            SaveExcelAsPDF strFilePath
                            
                        Case FILE_TYPE_PowerPoint
                            SavePowerPointAsPDF strFilePath
                    End Select
                    
                Case CHECKFILE_FileDoesNotExist
                    MsgBox """" & strFilePath & """", vbCritical, "File " & intCounter & " does not exist"
                    WScript.Quit
                    
                Case CHECKFILE_NotMSOFile
                    MsgBox """" & strFilePath & """", vbCritical, "File " & intCounter & " is not a valid file type"
                    WScript.Quit
            End Select
        Next
    Else
        'If there's not even one argument/file to process then exit
        Msgbox "Please pass a file to this script", 48,"No File Provided"
        WScript.Quit
    End If
    
    
    'Display an optional summary message
    If SUMMARY_DISPLAY then
        If colArgs.Count > 1 then
            MsgBox CStr(colArgs.Count) & " files converted.", vbInformation, SUMMARY_TITLE
        Else
            MsgBox "1 file converted.", vbInformation, SUMMARY_TITLE
        End If
    End If
End Sub
'---------------------
' MAIN ROUTINE FINISH
'---------------------


'--------------------
' SUB-ROUTINES START
'--------------------
Sub SaveExcelAsPDF(p_strFilePath)
    'Save Excel file as a PDF
    
    'Initialise
    Dim objExcel, objWorkbook
    Set objExcel = CreateObject("Excel.Application")
    
    'Open the file
    Set objWorkbook = objExcel.Workbooks.Open(p_strFilePath)
    
    'Save the PDF
    objWorkbook.ExportAsFixedFormat EXCEL_PDF, PathOfPDF(p_strFilePath), EXCEL_QualityStandard, TRUE, FALSE, , , FALSE
    
    'Close the file and exit the application
    objWorkbook.Close FALSE
    objExcel.Quit
End Sub


Sub SaveWordAsPDF(p_strFilePath)
    'Save Word file as a PDF
    
    'Initialise
    Dim objWord, objDocument
    Set objWord = CreateObject("Word.Application")
    
    'Open the file
    Set objDocument = objWord.Documents.Open(p_strFilePath)
    
    'Save the PDF
    objDocument.SaveAs PathOfPDF(p_strFilePath), WORD_PDF

    'Close the file and exit the application
    objDocument.Close FALSE
    objWord.Quit
End Sub


Sub SavePowerPointAsPDF(p_strFilePath)
    'Save PowerPoint file as a PDF (slides only)
    
    'Initialise
    Dim objPowerPoint, objSlideDeck
    Set objPowerPoint = CreateObject("PowerPoint.Application")
    
    'PowerPoint errors if it isn't visible :-(
    'objPowerPoint.Visible = TRUE
    
    'Open the file
    Set objSlideDeck = objPowerPoint.Presentations.Open(p_strFilePath, , , FALSE)
    
    'Save the PDF
    objSlideDeck.SaveAs PathOfPDF(p_strFilePath), POWERPOINT_PDF, True

    'Close the file and exit the application
    objSlideDeck.Close
    objPowerPoint.Quit
End Sub
'---------------------
' SUB-ROUTINES FINISH
'---------------------


'-----------------
' FUNCTIONS START
'-----------------
Function CheckFile(p_strFilePath)
    'Check file exists and is an office file (Excel, Word, PowerPoint)
    
    'Initialise
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Check the file exists and is an office file
    If IsOfficeFile(p_strFilePath) then
        If objFSO.FileExists(p_strFilePath) then
            CheckFile = CHECKFILE_OK
        Else
            CheckFile = CHECKFILE_FileDoesNotExist
        End If
    Else
        CheckFile = CHECKFILE_NotMSOFile
    End If
End Function


Function OfficeFileType(p_strFilePath)
    'Returns the type of office file, based upon file extension
    
    OfficeFileType = FILE_TYPE_NotOffice
    
    If IsWordFile(p_strFilePath) then
        OfficeFileType = FILE_TYPE_Word
    End If
    
    If IsExcelFile(p_strFilePath) then
        OfficeFileType = FILE_TYPE_Excel
    End If
    
    If IsPowerPointFile(p_strFilePath) then
        OfficeFileType = FILE_TYPE_PowerPoint
    End If
End Function

Function IsOfficeFile(p_strFilePath)
    'Returns true if a file is an office file (Excel, Word, PowerPoint)
    
    IsOfficeFile = IsWordFile(p_strFilePath) OR IsExcelFile(p_strFilePath) OR IsPowerPointFile(p_strFilePath)
End Function


Function IsWordFile(p_strFilePath)
    'Returns true if a file is a Word file
    
    IsWordFile = IsInList(GetFileExtension(p_strFilePath), g_strFileTypesWord)
End Function


Function IsExcelFile(p_strFilePath)
'Returns true if a file is an Excel file

    IsExcelFile = IsInList(GetFileExtension(p_strFilePath), g_strFileTypesExcel)
End Function


Function IsPowerPointFile(p_strFilePath)
'Returns true if a file is a PowerPoint file

    IsPowerPointFile = IsInList(GetFileExtension(p_strFilePath), g_strFileTypesPowerPoint)
End Function


Function IsInList(p_strSearchFor, p_strSearchIn)
    'Search a delimited list for a text string and return true if it's found
    
    Dim intResult
    
    intResult = InStr(1, p_strSearchIn, FILE_TYPE_DELIMITER & p_strSearchFor & FILE_TYPE_DELIMITER, vbTextCompare)
    
    If IsNull(intResult) then
        IsInList = FALSE
    Else
        If intResult = 0 then
            IsInList = FALSE
        Else
            IsInList = TRUE
        End If
    End If
End Function


Function GetFileExtension(p_strFilePath)
    'Return the file extension from a file path
    
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    GetFileExtension = objFSO.GetExtensionName(p_strFilePath)
End Function


Function PathOfPDF(p_strOriginalFilePath)
    'Return the path for the PDF file
    'The path will be the same as the original file but with a different file extension
    
    Dim objFSO
    
    'Initialise
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
        'Build the file path
    'Set the directory
    PathOfPDF = objFSO.GetParentFolderName(p_strOriginalFilePath) & "\"
    
    'Add the original file name without the extension
    PathOfPDF = PathOfPDF & Left(objFSO.GetFileName(p_strOriginalFilePath), Len(objFSO.GetFileName(p_strOriginalFilePath)) - Len(objFSO.GetExtensionName(p_strOriginalFilePath)))
    
    'Finally add the the new file extension
    PathOfPDF = PathOfPDF & PDF_Extension
End Function
'------------------
' FUNCTIONS FINISH
'------------------
Author: Stephen Millard
Tags: | scripting | vbs |

Buy me a coffeeBuy me a coffee



Related posts that you may also like to read