Skip to content

Instantly share code, notes, and snippets.

@d1mach
Created September 4, 2017 11:50
Show Gist options
  • Save d1mach/ca74b3878d22e381ba08c46ff0879a3c to your computer and use it in GitHub Desktop.
Save d1mach/ca74b3878d22e381ba08c46ff0879a3c to your computer and use it in GitHub Desktop.
VBScript to convert powerpoint slides to pdf with Microsoft Office
Option Explicit
Function GetOutputPath(inputPath, extension)
Dim file
Dim basename
Dim foldername
basename = FSO.GetBaseName( inputPath )
set file = FSO.GetFile( inputPath )
foldername = file.ParentFolder
GetOutputPath = foldername & "\" & basename & extension
End Function
Sub ConvertToPDF(ppt, inputpath, outputpath)
Dim presentation
Dim printoptions
ppt.Presentations.Open inputpath
set presentation = ppt.ActivePresentation
set printoptions = presentation.PrintOptions
printoptions.Ranges.Add 1,presentation.Slides.Count
printoptions.RangeType = 1 ' Show all.
const ppFixedFormatTypePDF = 2
const ppFixedFormatIntentScreen = 1
const msoFalse = 0
const msoTrue = -1
const ppPrintHandoutHorizontalFirst = 2
const ppPrintOutputSlides = 1
const ppPrintAll = 1
presentation.ExportAsFixedFormat outputpath, ppFixedFormatTypePDF, ppFixedFormatIntentScreen, msoTrue, ppPrintHandoutHorizontalFirst, ppPrintOutputSlides, msoFalse, printoptions.Ranges(1), ppPrintAll, inputFile, False, False, False, False, False
presentation.Close
End Sub
Dim FSO
Dim ppt
set FSO = CreateObject("Scripting.FileSystemObject")
set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True
If WScript.Arguments.Length > 0 Then
Dim inputFile
Dim inputpath
Dim outputpath
inputFile = WScript.Arguments(0)
If Not FSO.FileExists( inputFile ) Then
WScript.Stdout.Writeline "File not found: " & inputFile
End If
inputpath = FSO.GetAbsolutePathName( inputFile )
WScript.Stdout.WriteLine "Full path: " & inputpath
outputpath = GetOutputPath( inputpath, ".pdf" )
WScript.Stdout.WriteLine "Output path: " & outputpath
ConvertToPdf ppt, inputpath, outputpath
Else
Dim RootFolder
Dim folder
Dim fld
Dim folder_stack
Dim file_stack
Dim file
set folder_stack = CreateObject("System.Collections.Stack")
set file_stack = CreateObject("System.Collections.Stack")
set RootFolder = FSO.GetFolder(".")
folder_stack.push(RootFolder)
While folder_stack.Count > 0
set folder = folder_stack.pop()
WScript.Stdout.WriteLine "Processing " & folder.Name
If Folder.SubFolders.Count > 0 Then
For Each fld in folder.SubFolders
folder_stack.push(fld)
Next
Else
For Each file in folder.Files
Dim extension
extension = FSO.GetExtensionName(file.path)
If extension = "pptx" or extension = "ppt" Then
WScript.Stdout.WriteLine "Converting " & file.Path
outputpath = GetOutputPath( file.Path, ".pdf" )
ConvertToPDF ppt, file.Path, outputpath
End If
Next
End If
Wend
ppt.Quit
End If
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment