VBA Activepresentation.Saveas Error - 429 ActiveX - vba

Question

I am trying to run the following code and when I get to the ActivePresentation.SaveAs i get the the following error
Error - Run-time error '429': ActiveX component can't create object.
I have googled around the issue and cant seem to find a clear answer, some threads suggest it could be a referencing issue however i have updated my references and the problem has persisted.
Public Sub SaveNewVersion_PowerPoint()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
Dim TestStr As String
Dim myFileName As String
TestStr = ""
Saved = False
x = 2
'Version Indicator (change to liking)
VersionExt = "_v"
'Pull info about file
On Error GoTo NotSavedYet
myPath = "C:\Users\Person\Desktop\Test\Weekly Pack Update.pptx"
myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0
'Determine if file has ever been saved
If FolderPath = "" Then
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
Exit Sub
End If
'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActivePresentation.SaveAs FolderPath & SaveName & SaveExt 'Errors Here
Exit Sub
End If
'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActivePresentation.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt 'Error Here
Saved = True
Else
x = x + 1
End If
Loop
'New version saved
MsgBox "New file version saved (version " & x & ")"
Exit Sub
'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub

Answer 1

I cant claim to understand how this fixed it but i declared
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
then added in
Set ppApp = New PowerPoint.Application
i = 1
ppApp.Presentations.Open Filename:=myPath
Set ppPres = ppApp.Presentations.Item(i)
finally changing
Activepresentation.saveAs
to
ppPres.SaveAs
and it worked
Full code below:
Public Sub SaveNewVersion_PowerPoint()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
Dim TestStr As String
Dim myFileName As String
TestStr = ""
Saved = False
x = 2
'Version Indicator (change to liking)
VersionExt = "_v"
'Pull info about file
On Error GoTo NotSavedYet
myPath = "C:\Users\Person\Desktop\Test\Weekly Pack Update.pptx"
myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0
'Determine if file has ever been saved
If FolderPath = "" Then
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
Exit Sub
End If
'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActivePresentation.SaveAs FolderPath & SaveName & SaveExt 'Errors Here
Exit Sub
End If
'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActivePresentation.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt 'Error Here
Saved = True
Else
x = x + 1
End If
Loop
'New version saved
MsgBox "New file version saved (version " & x & ")"
Exit Sub
'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub