VBA to convert multiple PowerPoint files into one pdf

Hello,

From an excel workbook, I want to select a folder (with filepath referenced in cell k3) containing approx 20 PowerPoint presentations and export their content into a pdf file with the same name as the original but with the new .pdf suffix. I found some vba online which I have tried to adapt but it gives an error on the line which is removing the file extensions. Please would someone be willing to take a look and advise?

This is the line which is currently giving the error but I don�t know if this is the only problem;

removeFileExt = InStr(1, oPPTFile.Name, ".") - 1

Thank you,

Jess

Sub ppt2pdf()
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim onlyFileName As String, folderpath As String, pptFiles As String, removeFileExt As Long
 
Application.ScreenUpdating = False
 
'initialize variables
folderpath = Range("k3").Text & "\"
'pptFiles = Dir(folderpath & "*.pp*") (Original)
pptFiles = (folderpath & "*.pp*")
 
'check for ppt files and exit if not found
If pptFiles = "" Then
    MsgBox "No files found"
    Exit Sub
End If
 
Do While pptFiles <> ""
 
'Assign powerpoint application to variable
Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue
 
On Error Resume Next
 
'Assign powerpoint presentation to variable
Set oPPTFile = oPPTApp.Presentations.Open(folderpath & pptFiles)
 
On Error GoTo 0
 
'remove file extension and assign an only file name to a variable
removeFileExt = InStr(1, oPPTFile.Name, ".") - 1
 
onlyFileName = Left(oPPTFile.Name, removeFileExt)
 
On Error Resume Next
 
'Save ppt file to pdf file
oPPTFile.ExportAsFixedFormat oPPTFile.Path & "\" & onlyFileName & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint
oPPTFile.Close
 
'iterate to the next file in the folder
pptFiles = Dir()
Loop
 
'Close PPT application
oPPTApp.Quit
Set oPPTFile = Nothing
Set oPPTApp = Nothing
 
Application.ScreenUpdating = True
 
End Sub

Replace this

'remove file extension and assign an only file name to a variable
removeFileExt = InStr(1, oPPTFile.Name, ".") - 1
 
onlyFileName = Left(oPPTFile.Name, removeFileExt)

by

onlyFileName = CreateObject("scripting.filesystemobject").getbasename(oPPTFile.Name)

Also, why did you change this.

'pptFiles = Dir(folderpath & "*.pp*") (Original)
pptFiles = (folderpath & "*.pp*")

My best guess is that by doing so there are no files to proccess

This worked fine for me.

Sub ppt2pdf()
    Dim Path As String, FilesInPath As String, MyFiles() As String, Fnum As Long
    
    Application.ScreenUpdating = False
    Path = Sheets("Sheet1").Range("K3").Text & "\"
    FilesInPath = Dir(Path & "*.pp*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            With CreateObject("PowerPoint.Application")
                .Visible = msoTrue
                With .Presentations.Open(Path & MyFiles(Fnum))
                    onlyFileName = CreateObject("scripting.filesystemobject").getbasename(MyFiles(Fnum))
                    .SaveAs Path & onlyFileName & ".pdf", 32
                    .Close
                End With
            End With
        Next Fnum
    End If
End Sub

What do your filenames look like because as I said for me it works just fine.
Is the filepath in K3 correct ? Is the sheetname correct ?

I don't have experience with that but for testing purposes can you move some files to a folder on a local drive,
change the path in the sheet and try from there.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.

Also, you may not be aware that you can thank those who have helped you by clicking the small star icon (Next to Add Reputation) located in the lower left corner of the post in which the help was given. By doing so you can add to the reputation(s) of those who helped.

You're welcome and really glad it all turned out well.
Thanks for Rep+.