Excel Powerpoint Automation Run time Error

Hi All
I'm new to VBA, can you please assist.

I get the following error :

Run-time error'-2147467259 (80004005)';

Powerpoint could not open the file.


Please see below code used:


Private Const PivotChangeFieldName = "CODE"
Dim Path As String

Private Sub UpdatePivots()
Dim Pt As PivotTable
Dim Ws As Worksheet
Dim Field As PivotField
Dim Dealer As String

Dealer = Worksheets("Macro").Range("H6").Value

For Each Ws In ThisWorkbook.Worksheets
For Each Pt In Ws.PivotTables
If InStr(1, UCase(Pt.Name), "ALL") = 0 Then
With Ws.PivotTables(Pt.Name).PivotFields(PivotChangeFieldName)
.EnableMultiplePageItems = False

On Error Resume Next
.CurrentPage = Dealer
'If Err <> 0 Then
' Exit Sub 'Exit the loop if item doesnt exist
'End If
On Error GoTo 0
'Test if the item in the pivot table exists, if not, cancel

End With 'Change the filter
End If

Next Pt 'Loop all pivots in the sheet
Next Ws 'loop all sheets
End Sub

Private Sub Update_PowerPoint_Presentation()
'Opens a PowerPoint Document from Excel
Dim objPPT As Object
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
objPPT.Presentations.Open Path & "\Analysis.pptm"

'Update Link and Save Document to another name'
On Error GoTo 0
objPPT.ActivePresentation.UpdateLinks
objPPT.ActivePresentation.SaveAs Path & "\Output\" & Sheets("book1").Range("D43").Value & ".pdf", FileFormat:=ppSaveAsPDF
objPPT.Quit
Set objPPT = Nothing
End Sub


Public Sub Run_Reports()
Dim Count, Total As Double
Dim TimeBegin As Date

Total = CDbl(Sheets("Dealer Report Run").Range("G1").Value)
TimeBegin = Now()

Path = ThisWorkbook.Path

Application.StatusBar = "0.00%: Initiating"
Application.ScreenUpdating = False

For Count = 1094 To Total
Sheets("Macro").Range("H6").Value = Sheets("Report Run").Cells(Count + 1, 1).Value

Application.StatusBar = Round((Count / Total) * 100, 2) & "%: Updating Pivot (" & Count & " of " & Total & ") Estimated Time Remaining: " & Format(((Now() - TimeBegin) / Count) * (Total - Count), "HH:MM:SS") & "."
UpdatePivots

Application.StatusBar = Round((Count / Total) * 100, 2) & "%: Creating Presentation (" & Count & " of " & Total & ") Estimated Time Remaining: " & Format(((Now() - TimeBegin) / Count) * (Total - Count), "HH:MM:SS") & "."
Update_PowerPoint_Presentation

'If Count = 10 Then Exit For 'Only produce X reports

If (Count / 10) = Round(Count / 10, 0) Then DoEvents 'Update the screen if stopped updating
Next

Application.ScreenUpdating = True

Application.StatusBar = "Complete"

End Sub



Error normally errors at line :
objPPT.ActivePresentation.SaveAs Path & "\Output\" & Sheets("book1").Range("D43").Value & ".pdf", FileFormat:=ppSaveAsPDF


Does anyone know how to resolve this error.

Hi All
Something I forgot to mention, This code works, Runs for a few 100 iterations , then I get the error.