Search code examples
vbaexcelpowerpoint

SaveAs PPTM to PPTX


I need to turn a batch of pptm files into pptx. I tried to repurpose VBA code that turns xlsx files into xls files. The macro opens an xlsx file in a designated folder, saves it as an xls file, closes it, and moves on to the next file until all are converted. The original macro code was:

Sub ProcessFiles()
    Dim Filename, Pathname, saveFileName As String
    Dim wb As Workbook
    Dim initialDisplayAlerts As Boolean
    Pathname = "<insert_path_here>"  ' Needs to have a trailing \
    Filename = Dir(Pathname & "*.xlsx")
    initialDisplayAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=Pathname & Filename, _
                            UpdateLinks:=False)
    wb.CheckCompatibility = False
    saveFileName = Replace(Filename, ".xlsx", ".xls")
    wb.SaveAs Filename:=Pathname & saveFileName, _
              FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
              ReadOnlyRecommended:=False, CreateBackup:=False
    wb.Close SaveChanges:=False
    Filename = Dir()
    Loop
    Application.DisplayAlerts = initialDisplayAlerts
End Sub

I modified it in the following way:

Sub ProcessFiles()
    Dim Filename, Pathname, saveFileName As String
    Dim ppPres As Presentation
    Dim initialDisplayAlerts As Boolean
    Pathname = "\\TRIFS03\RoamingProfiles\user\Documents\projectfolder\testfolder\"  ' Needs to have a trailing \
    Filename = Dir(Pathname & "*.pptm")
    initialDisplayAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Do While Filename <> ""
    Set ppPres = Presentations.Open(Filename:=Pathname & Filename, _
                            UpdateLinks:=False)
    ppPres.CheckCompatibility = False
    saveFileName = Replace(Filename, ".pptm", ".pptx")
    ppPres.SaveAs Filename:=Pathname & saveFileName, _
              FileFormat:=ppSaveAsOpenXMLPresentation, Password:="", WriteResPassword:="", _
              ReadOnlyRecommended:=False, CreateBackup:=False
    ppPres.Close SaveChanges:=False
    Filename = Dir()
    Loop
    Application.DisplayAlerts = initialDisplayAlerts
End Sub

I get

Compile Error Named Argument Not Found

pointing to UpdateLinks:=.

I did some research and found that I should delete this bit of code. I was left with the following:

Sub ProcessFiles()
    Dim Filename, Pathname, saveFileName As String
    Dim ppPres As Presentation
    Dim initialDisplayAlerts As Boolean
    Pathname = "\\TRIFS03\RoamingProfiles\user\Documents\projectfolder\testfolder\"  ' Needs to have a trailing \
    Filename = Dir(Pathname & "*.pptm")
    initialDisplayAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Do While Filename <> ""
        Set ppPres = Presentations.Open(Filename:=Pathname & Filename)
        ppPres.CheckCompatibility = False
        saveFileName = Replace(Filename, ".pptm", ".pptx")
        ppPres.SaveAs Filename:=Pathname & saveFileName, _
              FileFormat:=ppSaveAsOpenXMLPresentation, Password:="", WriteResPassword:="", _
              ReadOnlyRecommended:=False, CreateBackup:=False
        ppPres.Close SaveChanges:=False
        Filename = Dir()
    Loop
    Application.DisplayAlerts = initialDisplayAlerts
End Sub

I got

Compile Error Method or Data Member not Found

pointing to .CheckCompatability =.

I tried deleting THAT one.

Compile Error Named Argument Not Found

pointing to Password:=.

I decided to look for a new macro:

With ActivePresentation
    .SaveCopyAs _
      FileName:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
      FileFormat:=ppSaveAsOpenXMLPresentation
End With

I added loop code and ended up with:

Sub ProcessFiles()
    Dim Filename, FileFormat As String
    Dim initialDisplayAlerts As Boolean
    initialDisplayAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Do While Filename <> ""
        .SaveCopyAs _
          Filename:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
          FileFormat:=ppSaveAsOpenXMLPresentation
        ppPres.Close SaveChanges:=False
        Filename = Dir()
    Loop
    Application.DisplayAlerts = initialDisplayAlerts
End Sub

Which ended up with

Compile Error Invalid or Unqualified Reference

with .Path being pointed to as the culprit.
According to the code’s author (see top voted answer), I shouldn’t need to define .Path if I’m using \.


Solution

  • Something like:

    Sub ProcessFiles()
        Dim Filename, FileFormat As String
        Dim initialDisplayAlerts As Boolean
        initialDisplayAlerts = Application.DisplayAlerts
        Application.DisplayAlerts = False
        With ActivePresentation
            Do While Filename <> ""
    
                .SaveCopyAs _
                  Filename:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
                                    FileFormat:=ppSaveAsOpenXMLPresentation
    
               Filename = Dir()
           Loop
       End With
       Application.DisplayAlerts = initialDisplayAlerts
    End Sub