Method 'Open' of object 'Presentations' failed when running a VBA loop

Hello Excel Gurus,

This is the first time I am trying to make a VBA macro which generates PDF presentations automatically, so I am a newbie to this. It works to run once, but I get an error message when the macro runs a second time in a loop.

I get the following two error messages:
- Method 'Open' of object 'Presentations' failed
- The remote server machine does not exist or is unavailable (run-time error '462')

I have Googled around a bit to figure out what the issue is, but not found a solution which I fully understand, i.e. I still do not know what is missing in my code.

I am using the below code:

PHP Code: 

Sub generateReport()
      
    Dim PPT As PowerPoint.Application
    Set PPT = New PowerPoint.Application
    PPT.Visible = True
    
    Dim objReport As Presentation
    Dim objSlide As Slide
    Dim objShape As Object
     
    excelPath = Application.ActiveWorkbook.Path
    pptTemplateName = "Report.pptx"
    
    'THIS IS WHERE THE ERROR APPEARS IN THE SECOND LOOP'
    Set objReport = PPT.Presentations.Open(Filename:=excelPath & "\" & pptTemplateName)    
    
    'Defining presentation version'
    versionNumber = Sheets("Analysis").Range("D4").Value 

    'Inputting text to presentation from Excel'
    Dim i As Integer
    
    firstInputRow = 38
    inputLength = Sheets("Analysis").Range("D" & firstInputRow - 3).Value
    
    For i = 1 To inputLength
    
        slideNum = Sheets("Analysis").Range("B" & firstInputRow + i - 1).Value
        boxName = Sheets("Analysis").Range("C" & firstInputRow + i - 1).Value
        textInput = Sheets("Analysis").Range("D" & firstInputRow + i - 1).Value
      
        Set objSlide = objReport.Slides(slideNum)
        objSlide.Shapes(boxName).TextFrame.TextRange.Text = textInput
  
    Next i

    'Updating charts in presentation'
    inputLength = Sheets("Analysis").Range("J" & firstInputRow - 3).Value
      
    For i = 1 To inputLength
    
        slideNum = Sheets("Analysis").Range("I" & firstInputRow + i - 1).Value
        boxName = Sheets("Analysis").Range("J" & firstInputRow + i - 1).Value
        objReport.Slides(slideNum).Shapes(boxName).LinkFormat.Update
      
    Next i
    
    'Saving presentation as PDF'
    FileName2 = Replace(excelPath & "\" & versionNumber & " " & pptTemplateName, "pptx", "pdf")
    
    objReport.SaveAs FileName2, ppSaveAsPDF
    objReport.Close

    Set objShape = Nothing
    Set objSlide = Nothing
    Set objReport = Nothing
    
    PPT.Quit
    Set PPT = Nothing
    
End Sub 


Any help would be greatly appreciated.

That is a Windows thing. It is often referred to as the 3 finger salute. For more detail see: https://technet.microsoft.com/en-us/...(v=ws.11).aspx

It is an easy way to see if you have an orphan task like the ppt file still open. Setting your object to Nothing should fix that. Howsoever, when it errors, setting those will not happen. You need an Error catching routine.

e.g.

'2nd line
On Error Goto TheEnd
'line before setting objects to nothing
TheEnd:

Of course you may want a 2nd Goto so that you can skip a MsgBox that shows that an error occurred.

Example error handling:

Sub AnError()
  CorrectTimepoint 1
End Sub

Sub NoError()
  CorrectTimepoint 0
  MsgBox "CorrectTimepoint generated no error."
End Sub

Sub CorrectTimepoint(aNumber As Long)
  Dim Msg As String
  On Error GoTo ErrMsg
  If aNumber <> 0 Then Err.Raise aNumber
  MsgBox "aNumber=0 so no error was generated."
  
  Exit Sub
ErrMsg:
  Msg = "Error # " & Str(Err.Number) & " was generated by " _
    & Err.Source & Chr(13) & Err.Description
  MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
  End
End Sub

Are you calling this sub from a loop in another sub?

Does this work any better?

Sub generateReport()

Const ppSaveAsPDF = 32

Dim PPT As Object  ' PowerPoint.Application
Dim objReport As Object    ' Presentation
Dim objSlide As Object    ' Slide
Dim objShape As Object
Dim excelPath As String
Dim pptTemplateName As String
Dim FileName2 As String
Dim versionNumber As Long
Dim firstInputRow As Long
Dim inputLength As Long
Dim slideNum As Long
Dim boxName As Long
Dim textInput As Long
Dim i As Long

    Set PPT = CreateObject("PowerPoint.Application")

    PPT.Visible = True

    excelPath = Application.ActiveWorkbook.Path
    pptTemplateName = "Report.pptx"

    'THIS IS WHERE THE ERROR APPEARS IN THE SECOND LOOP'
    Set objReport = PPT.Presentations.Open(Filename:=excelPath & "\" & pptTemplateName)

    'Defining presentation version'
    versionNumber = Sheets("Analysis").Range("D4").Value

    'Inputting text to presentation from Excel'


    firstInputRow = 38
    inputLength = Sheets("Analysis").Range("D" & firstInputRow - 3).Value

    For i = 1 To inputLength

        slideNum = Sheets("Analysis").Range("B" & firstInputRow + i - 1).Value
        boxName = Sheets("Analysis").Range("C" & firstInputRow + i - 1).Value
        textInput = Sheets("Analysis").Range("D" & firstInputRow + i - 1).Value

        Set objSlide = objReport.Slides(slideNum)
        objSlide.Shapes(boxName).TextFrame.TextRange.Text = textInput

    Next i

    'Updating charts in presentation'
    inputLength = Sheets("Analysis").Range("J" & firstInputRow - 3).Value

    For i = 1 To inputLength

        slideNum = Sheets("Analysis").Range("I" & firstInputRow + i - 1).Value
        boxName = Sheets("Analysis").Range("J" & firstInputRow + i - 1).Value
        objReport.Slides(slideNum).Shapes(boxName).LinkFormat.Update

    Next i

    'Saving presentation as PDF'
    FileName2 = Replace(excelPath & "\" & versionNumber & " " & pptTemplateName, "pptx", "pdf")

    objReport.SaveAs FileName2, ppSaveAsPDF
    objReport.Close

    Set objShape = Nothing
    Set objSlide = Nothing
    Set objReport = Nothing

    PPT.Quit
    Set PPT = Nothing

End Sub

How are you running the code multiple times?

Within a loop?

Calling it from within a loop in another sub?