Search code examples
vbapdfoffice365powerpointms-office

PowerPoint macro that converts all PowerPoint files in the same directory to PDF all at once

I'd like to create a PowerPoint macro that converts all PowerPoint files in the same directory to PDF all at once, but it doesn't work.

My request:

Create PowerPoint macro that meets the requirements below; you can modify the code below or create a new one, but please create a macro that works well on Windows 10.

The main required specifications are as follows;

  • (1) Convert all PowerPoint files in the same directory of itself(TEST.ppt) to PDF all at once. enter image description here
  • (2) Please treat files with the extension ppt or pptx as PowerPoint files.
  • (3) Please make the file name of the pdf file the same as the original file name. In other words, if the file name of the PPT file to be converted is "original file name.ppt", the file name of the output PDF file should be "original file name.pdf".
  • (4) To save the converted PDF file, create a directory called PDF one level below the directory you are in and store it there.

The following is an example I created using PowerPoint's ExportAsFixedFormat method, but I get Error: 13 on the line of "objPresentation.ExportAsFixedFormat pdfFile, ppFixedFormatTypePDF".

enter image description here

Original code, I created it　but has Errors.

Sub ConvertPowerPointToPDF()
    Dim folderPath As String
    Dim pptFile As String
    Dim pdfFile As String
    Dim pdfFolderPath As String
    Dim objPPT As Object
    Dim objPresentation As Object
    
' Get the current directory path
    folderPath = ActivePresentation.Path

'Create a directory to save the PDF
    pdfFolderPath = folderPath & "\PDF"
    If Dir(pdfFolderPath, vbDirectory) = "" Then
        MkDir pdfFolderPath
    End If
    
' Repeat for all PowerPoint files in the directory
    pptFile = Dir(folderPath & "\*.ppt*")
    
    Do While pptFile <> ""
    
' Exclude current presentation (self)
        If pptFile <> ActivePresentation.Name Then
' Create a PowerPoint application
            Set objPPT = CreateObject("PowerPoint.Application")
            objPPT.Visible = msoTrue 'Uncomment out to display PowerPoint
           
            'Open the presentation
            Set objPresentation = objPPT.Presentations.Open(folderPath & "\" & pptFile)
            
            'Set document properties
            objPresentation.BuiltInDocumentProperties("Title") = objPresentation.BuiltInDocumentProperties("Title")
            objPresentation.BuiltInDocumentProperties("Subject") = objPresentation.BuiltInDocumentProperties("Subject")
            objPresentation.BuiltInDocumentProperties("Author") = objPresentation.BuiltInDocumentProperties("Author")
            objPresentation.BuiltInDocumentProperties("Keywords") = objPresentation.BuiltInDocumentProperties("Keywords")
            objPresentation.BuiltInDocumentProperties("Comments") = objPresentation.BuiltInDocumentProperties("Comments")
            objPresentation.BuiltInDocumentProperties("Last Author") = objPresentation.BuiltInDocumentProperties("Last Author")
            
           'Save as PDF
            pdfFile = pdfFolderPath & "\" & Left(pptFile, Len(pptFile) - InStrRev(pptFile, ".")) & ".pdf"
            objPresentation.ExportAsFixedFormat pdfFile, ppFixedFormatTypePDF
            
           ' Close the presentation
            objPresentation.Close
            
          ' Close the PowerPoint application
            objPPT.Quit
        End If
        
      ' Go to next PowerPoint file
        pptFile = Dir
    Loop
End Sub

Code modified with advice from this thread. Seens like the bug has been resolved.

Sub ConvertPowerPointToPDF()
    Dim folderPath As String
    Dim pptFile As String
    Dim pdfFile As String
    Dim pdfFolderPath As String
    Dim objPPT As Object
    Dim objPresentation As Object
    
    ' Get the current directory path
    folderPath = ActivePresentation.Path
    
    'Create a directory to save the PDF
    pdfFolderPath = folderPath & "\PDF"
    If Dir(pdfFolderPath, vbDirectory) = "" Then
        MkDir pdfFolderPath
    End If
    
   ' Repeat for all PowerPoint files in the directory
    pptFile = Dir(folderPath & "\*.ppt*")
    
    Do While pptFile <> ""
        ' Exclude current presentation (self)
        If pptFile <> ActivePresentation.Name Then
           ' Create a PowerPoint application
            Set objPPT = CreateObject("PowerPoint.Application")
            objPPT.Visible = msoTrue
           
            'open presentation
            Set objPresentation = objPPT.Presentations.Open(folderPath & "\" & pptFile)
            

            ' Save as PDF
            pdfFile = pdfFolderPath & "\" & Left(pptFile, InStrRev(pptFile, ".")) & "pdf"

            objPresentation.SaveAs pdfFile, ppSaveAsPDF
            
            'Close presentation
            objPresentation.Close
            

        End If
        
        ' Advance to next PowerPoint file
        pptFile = Dir
    Loop
End Sub
Solution
    • Add PrintRange:=Nothing to make it works.
    objPresentation.ExportAsFixedFormat pdfFile, ppFixedFormatTypePDF, PrintRange:=Nothing
    • PrintRange is an optional parameter according to the official Microsoft documentation. However, in the code, you must explicitly specify it. This appears to be either a bug or a typo in the documentation.

    Microsoft documentation:

    Presentation.ExportAsFixedFormat method (PowerPoint)

    • Another option is SaveAs
    objPresentation.SaveAs pdfFile, ppSaveAsPDF

    Microsoft documentation:

    Presentation.SaveAs method (PowerPoint)