Split PowerPoint Presentation into single PDF files

SplitPresentation2PDF.txt

Option Explicit

Public Sub SplitPresentation2PDF()

Dim CurrentPres As Presentation
Dim strPath As String
Dim strExtension As String
Dim strFileName As String
Dim iNumOfSlides As Long
Dim i As Long
Dim strFormat As String
Dim strSplitName As String
Dim icurrentslide As Long

On Error GoTo ErrorHandler

Set CurrentPres = ActivePresentation

strPath = ActivePresentation.path & "\"
strExtension = "pdf"
strFileName = Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1)

iNumOfSlides = CurrentPres.Slides.Count
strFormat = getStringFormat(iNumOfSlides)
icurrentslide = ActiveWindow.Selection.SlideRange.SlideIndex

For i = 1 To iNumOfSlides
    strSplitName = strPath & strFileName & "_" & Format$(i, strFormat) & "." & LCase(strExtension)
    
    If LCase(strExtension) <> "pdf" Then
        CurrentPres.Slides(i).Export strSplitName, UCase(strExtension)
    Else
        CurrentPres.Slides(i).Select
        CurrentPres.ExportAsFixedFormat strSplitName, ppFixedFormatTypePDF, ppFixedFormatIntentPrint, msoFalse, ppPrintHandoutHorizontalFirst, ppPrintOutputSlides, msoFalse, , ppPrintCurrent
    End If
Next

GoTo Success

Success:
CurrentPres.Slides(icurrentslide).Select
Exit Sub

ErrorHandler:
    If Err <> 0 Then
    MsgBox Err.Description
    End If

End Sub

Private Function getStringFormat(i As Long)
    getStringFormat = String(Len(str(i) - 1), "0")
End Function