Trying to use handling to catch Run-time error -2147188160 (80048240)

Question

I am trying to use On Error GoTo Handle to catch an inconsistent

Run-time error -2147188160 (80048240)

My code generates 4 powerpoints from an excel template, saves them and closes them. Here is my experimental error handling at the bottom:

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
If Err.Number = -2147188160 Then
    PPT.Quit
    MsgBox "Hey look I broke!"
End If
End Sub

But in my testing, when I hit the error I don't get any error message, but my code doesn't run either. This leads me to believe that I am catching the error, but something else isn't firing. I've tried addressing the root cause of the error before but the solution has been to just add Application.Wait throughout my code, which I feel is unnecessary.

In a perfect world I just want to catch the error, close PowerPoint and have it instantly run the code over again. Any insight?

Full subroutine for those interested - The place of the error is inconsistent:

Public Declare Function GetWindowThreadProcessId Lib "user32" _
      (ByVal hwnd As Long, lpdwprocessid As Long) As Long
Sub GeneratePowerPoints()

'For using powerpoint
Dim dummyfile As String
Dim PPT As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim MySlide As Object
Dim MyShape As Object

Dim j As Long, allhotels() As Variant, sourcerange As Range, sourcebook As String
Dim d As Date, e As Date, f As Date, lastmonth As String, twomonthsago As String, threemonthsago As String

'Get some month names
d = DateAdd("m", -1, Now)
e = DateAdd("m", -2, Now)
f = DateAdd("m", -3, Now)
lastmonth = Format(d, "mmmm")
twomonthsago = Format(e, "mmmm")
threemonthsago = Format(f, "mmmm")

sourcebook = "BT Strat Sheet.xlsm"
allhotels = Array("SBH", "WBOS", "WBW", "WCP")
dummyfile = "P:\BT\BT 2017\BT Strategy Meetings\2017\Hotel Strat Meeting Dummy File.pptx"

On Error GoTo Handle
For j = 0 To 3

    Set PPT = New PowerPoint.Application
    PPT.Visible = True
    PPT.Presentations.Open Filename:=dummyfile

    'SLIDE ONE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A2:J21")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(1).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(1).Shapes(PPT.ActivePresentation.Slides(1).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A82:J91")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 92
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A94:J103")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 300
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE THREE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A24:J43")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(3).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(3).Shapes(PPT.ActivePresentation.Slides(3).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A58:J67")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 120
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A46:J55")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 335
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FIVE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A70:J79")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(5).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(5).Shapes(PPT.ActivePresentation.Slides(5).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'Find and replace month placeholders
    'Straight boilerplate
    Dim sld As Slide, shp As PowerPoint.Shape, i As Long

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "LastMonth", lastmonth)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "TwoMonthsAgo", twomonthsago)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "ThreeMonthsAgo", threemonthsago)
                End If
            End If
        Next shp
    Next sld

    'Save it
    PPT.ActivePresentation.SaveAs "P:\BT\BT File Drop-off Location\" & allhotels(j) & " " & lastmonth & " Strat Meeting.pptx"

    'Close it
    PPT.ActivePresentation.Close
Next j

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
Call KillProcess(PPT)
MsgBox "Hey look I broke!"

End Sub
Sub KillProcess(ByVal app As PowerPoint.Application)

    ' This is OK Here, Because We Can Assume If We Get No Handle Back, There's No Handle To Cleanup
    ' Don't Normally Do This
    On Error Resume Next

    Dim windowProcessId As Long
    windowProcessId = ProcIDFromWnd(app.ActiveWindow.hwnd)

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process Where ProcessId=" & windowProcessId)

    For Each oProc In cProc

          MsgBox "Killing Process " & windowProcessId   ' used to display a message for testing pur
          errReturnCode = oProc.Terminate()
    Next

End Sub
Function ProcIDFromWnd(ByVal hwnd As Long) As Long
   Dim idProc As Long

   ' Get PID for this HWnd
   GetWindowThreadProcessId hwnd, idProc
   ProcIDFromWnd = idProc
End Function

EDIT: After the suggestion of Absinthe I was able to debug.print to confirm the error number is indeed -2147188160. I am now able to successsfully run code only if that error occurs, however I can't get PowerPoint to quit - I have to close PowerPoint myself and then I can see the MsgBox is up on my excel screen:

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
Debug.Print Err.Number
If Err.Number = -2147188160 Then
PPT.Quit
MsgBox "Oh look I broke!"
End If

Answer 1

If the PowerPoint isn't quitting, it is probably due to some open references sitting out there. You are in a weird state due to the error so I recommend you kill the process associated with the main window handle (wouldn't recommend this in an abnormal state).

In this case, you'll need to know which PPT processes were started by the automation and kill those.

This process gets the process at the start (PPT only) and the processes at the end, and kills the new one.

Public PpProcesses() As Integer

Sub GeneratePowerPoints()


    Call SaveProcesses

'For using powerpoint
Dim dummyfile As String
Dim PPT As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim MySlide As Object
Dim MyShape As Object

Dim j As Long, allhotels() As Variant, sourcerange As Range, sourcebook As String
Dim d As Date, e As Date, f As Date, lastmonth As String, twomonthsago As String, threemonthsago As String

'Get some month names
d = DateAdd("m", -1, Now)
e = DateAdd("m", -2, Now)
f = DateAdd("m", -3, Now)
lastmonth = Format(d, "mmmm")
twomonthsago = Format(e, "mmmm")
threemonthsago = Format(f, "mmmm")

sourcebook = "BT Strat Sheet.xlsm"
allhotels = Array("SBH", "WBOS", "WBW", "WCP")
dummyfile = "P:\BT\BT 2017\BT Strategy Meetings\2017\Hotel Strat Meeting Dummy File.pptx"

On Error GoTo Handle
For j = 0 To 3

    Set PPT = New PowerPoint.Application
    PPT.Visible = True
    PPT.Presentations.Open Filename:=dummyfile

    'SLIDE ONE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A2:J21")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(1).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(1).Shapes(PPT.ActivePresentation.Slides(1).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A82:J91")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 92
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A94:J103")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 300
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE THREE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A24:J43")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(3).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(3).Shapes(PPT.ActivePresentation.Slides(3).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A58:J67")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 120
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A46:J55")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 335
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FIVE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A70:J79")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(5).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(5).Shapes(PPT.ActivePresentation.Slides(5).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'Find and replace month placeholders
    'Straight boilerplate
    Dim sld As Slide, shp As PowerPoint.Shape, i As Long

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "LastMonth", lastmonth)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "TwoMonthsAgo", twomonthsago)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "ThreeMonthsAgo", threemonthsago)
                End If
            End If
        Next shp
    Next sld

    'Save it
    PPT.ActivePresentation.SaveAs "P:\BT\BT File Drop-off Location\" & allhotels(j) & " " & lastmonth & " Strat Meeting.pptx"

    'Close it
    PPT.ActivePresentation.Close
Next j

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
MsgBox Err.Number
Call KillProcess
MsgBox "Hey look I broke!"

End Sub


Public Sub SaveProcesses()

    ReDim PpProcesses(1 To 1)

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    For Each oProc In cProc

        If UCase(oProc.Name) = "POWERPNT.EXE" Or UCase(oProc.Name) = "POWERPNT" Then

            ReDim Preserve PpProcesses(1 To UBound(PpProcesses) + 1)
            PpProcesses(UBound(PpProcesses)) = oProc.ProcessId

        End If
    Next

End Sub

Sub KillProcess()

    Dim index As Integer
    index = -1

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    For Each oProc In cProc

         If UCase(oProc.Name) = "POWERPNT.EXE" Or UCase(oProc.Name) = "POWERPNT" Then


            For i = LBound(PpProcesses) To UBound(PpProcesses)
                If PpProcesses(i) = oProc.ProcessId Then
                    index = i
                    Exit For
                End If
            Next i

            If index >= 0 Then
                'MsgBox ("Process Found " & oProc.ProcessId)
            Else
                oProc.Terminate
            End If
         End If
    Next

End Sub

Answer 2

This could be due to the fact that another error with another error number is raised while the macro runs. To avoid missing this error, you can add a different message if the number is not the one you want.

Handle:
If Err.Number = -2147188160 Then
    PPT.Quit
    MsgBox "Hey look I broke!"
else
    MsgBox("Run-time error '" & Err.Number & "': " & Err.Description, vbCritical, "Error")
End If