The Headache

I’ve been experiencing issues with longstanding code that opens other Office applications (Excel, PowerPoint, Word) are not managing to close the applications even though the code used to work just fine. This is especially true of PowerPoint! So you end up with hidden processes running in the background and this can lock files and cause all sorts of headaches.

Now, I can’t say why this is now happening, when the .Quit command used to work beautifully, but I had to come up with a way to insure that I didn’t leave such processes, below is my solution.

The Solution

Elegant it is not, but so far the only solution has been to kill the process just as you would do by opening the task manager and killing it there.  The code I came up with to do this is:

Public Declare Function GetWindowThreadProcessId Lib "user32" _
                                                 (ByVal lHWnd As Long, _
                                                  ByRef lProcessId As Long) As Long

'---------------------------------------------------------------------------------------
' Procedure : KillHwndProcess
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Terminate a process based on its Windows Handle (Hwnd)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' lHWnd     : Windows Handle number (Hwnd)
'
' Usage:
' ~~~~~~
' Call KillHwndProcess(Application.hWnd)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-09-09              Initial Website Release
'---------------------------------------------------------------------------------------
Public Function KillHwndProcess(lHWnd As Long)
' https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-process
    On Error GoTo Error_Handler
    Dim oWMI                  As Object
    Dim oProcesses            As Object
    Dim oProcess              As Object
    Dim lProcessId            As Long
    Dim sSQL                  As String
    Const sComputer = "."

    'Retrieve the ProcessId associated with the specified Hwnd
    Call GetWindowThreadProcessId(lHWnd, lProcessId)

    'Iterate through the matching ProcessId processes and terminate
    '   each one.
    Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
    sSQL = "SELECT * FROM Win32_Process WHERE ProcessId=" & lProcessId
    Set oProcesses = oWMI.ExecQuery(sSQL)
    For Each oProcess In oProcesses
        oProcess.Terminate
    Next

Error_Handler_Exit:
    On Error Resume Next
    If Not oProcess Is Nothing Then Set oProcess = Nothing
    If Not oProcesses Is Nothing Then Set oProcesses = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: KillHwndProcess" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

This code simply requires that you pass it the Handle of the application to forcibly close.

Some Examples

Below are a couple examples of how it can be implemented.

Excel

Public Sub RunXLS()
    Dim oExcel                As Object
    Dim oExcelWrkBk           As Object

    'Start Excel
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel
    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        Set oExcel = CreateObject("Excel.Application")
    End If
    On Error GoTo Error_Handler
    oExcel.ScreenUpdating = True
    oExcel.Visible = True   'Keep Excel hidden until we are done with our manipulation
    Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook

    '    oExcel.Quit ' Normal, polite way to close Excel, commented out for demonstrative purposes only

    DoEvents
    'Maybe throw in a wait period to give the PC a chance to close the App before forcing it
    Call KillHwndProcess(oExcel.hWnd)

Error_Handler_Exit:
    On Error Resume Next
    oExcel.Visible = True   'Make excel visible to the user
    oExcel.ScreenUpdating = True
    Set oExcelWrkBk = Nothing
    Set oExcel = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: RunXLS" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Word

Sub RunDoc()
    Dim oWord                 As Object
    Dim oWordDoc              As Object

    'Start Word
    On Error Resume Next
    Set oWord = GetObject("Word.Application")    'Bind to existing instance of Word
    If Err.Number <> 0 Then    'Could not get instance of Word, so create a new one
        Err.Clear
        Set oWord = CreateObject("Word.Application")
    End If
    On Error GoTo Error_Handler
    oWord.Visible = True   'Keep Word hidden until we are done with our manipulation
    Set oWordDoc = oWord.Documents.Add   'Start a new document

    '    oWord.Quit    ' Normal, polite way to close Word, commented out for demonstrative purposes only

    DoEvents
    'Maybe throw in a wait period to give the PC a chance to close the App before forcing it
    Call KillHwndProcess(oWord.ActiveWindow.hWnd)

Error_Handler_Exit:
    On Error Resume Next
    oWord.Visible = True   'Make Word visible to the user
    Set oWordDoc = Nothing
    Set oWord = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: RunDoc" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Internet Explorer

Function RunIE()
    Dim oIE                   As Object     'SHDocVw.InternetExplorer

    On Error GoTo Error_Handler
    Set oIE = CreateObject("InternetExplorer.Application")

    With oIE
        .Navigate "https://google.com"
        .Visible = True    'True/False
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
    End With

    '    oIE.Quit    ' Normal, polite way to close Internet Explorer, commented out for demonstrative purposes only

    DoEvents
    'Maybe throw in a wait period to give the PC a chance to close the App before forcing it
    Call KillHwndProcess(oIE.hWnd)

Error_Handler_Exit:
    On Error Resume Next
    Set oIE = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: RunIE" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

PowerPoint

PowerPoint is a very special case as there appears to be no way to natively get the Handle to use to close the application. So we have to use convoluted code and use the Presentation’s Caption to determine the Handle using APIs and then use it to close the instance.

To determine the Handle from the caption, there is simply no point in reinventing the wheel. Simply use Wayne Phillips’ code, see: https://www.everythingaccess.com/tutorials.asp?ID=Bring-an-external-application-window-to-the-foreground

' Module Name: ModFindWindowLike
' (c) 2005 Wayne Phillips (www.everythingaccess.com)
' https://www.everythingaccess.com/tutorials.asp?ID=Bring-an-external-application-window-to-the-foreground
' Written 02/06/2005
                    
Private Declare Function EnumWindows Lib "user32" _
   (ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long

'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters
    strTitle As String  'INPUT
    hWnd As Long        'OUTPUT
End Type

Public Function FnFindWindowLike(strWindowTitle As String) As Long
    'We'll pass a custom structure in as the parameter to store our result...
    Dim Parameters As FindWindowParameters
    Parameters.strTitle = strWindowTitle ' Input parameter

    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
    
    FnFindWindowLike = Parameters.hWnd
End Function

Private Function EnumWindowProc(ByVal hWnd As Long, _
                               lParam As FindWindowParameters) As Long
   Dim strWindowTitle As String

   strWindowTitle = Space(260)
   Call GetWindowText(hWnd, strWindowTitle, 260)
   strWindowTitle = TrimNull(strWindowTitle) ' Remove extra null terminator
                                          
   If strWindowTitle Like lParam.strTitle Then
        lParam.hWnd = hWnd 'Store the result for later.
        EnumWindowProc = 0 'This will stop enumerating more windows
   Else
        EnumWindowProc = 1
   End If
End Function

Private Function TrimNull(strNullTerminatedString As String)
    Dim lngPos As Long

    'Remove unnecessary null terminator
    lngPos = InStr(strNullTerminatedString, Chr$(0))
   
    If lngPos Then
        TrimNull = Left$(strNullTerminatedString, lngPos - 1)
    Else
        TrimNull = strNullTerminatedString
    End If
End Function

Now that we have that, we can now continue with our example.

Sub RunPpt()
    Dim oPpt                  As Object
    Dim oPptPres              As Object
    Dim sPptCaption           As String

    'Start Word
    On Error Resume Next
    Set oPpt = GetObject("PowerPoint.Application")    'Bind to existing instance of PowerPoint
    If Err.Number <> 0 Then    'Could not get instance of PowerPoint, so create a new one
        Err.Clear
        Set oPpt = CreateObject("PowerPoint.Application")
    End If
    On Error GoTo Error_Handler
    oPpt.Visible = True   'Keep PowerPoint hidden until we are done with our manipulation
    Set oPptPres = oPpt.Presentations.Add   'Start a new presentation
    '    Set oPptSlide = oPpt.ActivePresentation.Slides.Add(1, 2) 'Add a new slide

    '    oPptPres.Close
    '    oPpt.Quit    ' Normal, polite way to close PowerPoint, commented out for demonstrative purposes only
    ' Does not work with PPT?!

    DoEvents
    'Maybe throw in a wait period to give the PC a chance to close the App before forcing it
    'No way to get the PPT Hwnd so we have to use an API, grrr....  
    '    Thank you Microsoft for standardizing your Office Properties!
    sPptCaption = oPpt.Caption & "*"
    Call KillHwndProcess(FnFindWindowLike(sPptCaption))

Error_Handler_Exit:
    On Error Resume Next
    oPpt.Visible = True   'Make Word visible to the user
    Set oPptPres = Nothing
    Set oPpt = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: RunPpt" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Now this way of insuring an application is actually shutdown can be added after a standard .Quit call without issue since it will look for the Hwnd, so if it is already closed, it won’t find it, and so it won’t do anything. On the other hand, it the handle remains open, even after you asked it politely to close, then the will forcibly close it.