SaveAs PPTM to PPTX - vba

Question

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 \.

Answer 1

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