VBA script to close every instance of Excel except itself

Question

I have a subroutine in my errorhandling function that attempts to close every workbook open in every instance of Excel. Otherwise, it might stay in memory and break my next vbscript. It should also close every workbook without saving any changes.

Sub CloseAllExcel()
On Error Resume Next
    Dim ObjXL As Excel.Application
    Set ObjXL = GetObject(, "Excel.Application")
    If Not (ObjXL Is Nothing) Then
        Debug.Print "Closing XL"
        ObjXL.Application.DisplayAlerts = False
        ObjXL.Workbooks.Close
        ObjXL.Quit
        Set ObjXL = Nothing
    Else
        Debug.Print "XL not open"
    End If
End Sub

This code isn't optimal, however. For example, it can close 2 workbooks in one instance of Excel, but if you open 2 instances of excel, it will only close out 1.

How can I rewrite this to close all Excel without saving any changes?

Extra Credit:

How to do this for Access as well without closing the Access file that is hosting this script?

Answer 1

You should be able to use window handles for this.

Public Sub CloseAllOtherAccess()
    Dim objAccess As Object
    Dim lngMyHandle As Long
    Dim strMsg As String

On Error GoTo ErrorHandler
    lngMyHandle = Application.hWndAccessApp

    Set objAccess = GetObject(, "Access.Application")
    Do While TypeName(objAccess) = "Application"
        If objAccess.hWndAccessApp <> lngMyHandle Then
            Debug.Print "found another Access instance: " & _
                objAccess.hWndAccessApp
            objAccess.Quit acQuitSaveNone
        Else
            Debug.Print "found myself"
            Exit Do
        End If
        Set objAccess = GetObject(, "Access.Application")
    Loop

ExitHere:
    Set objAccess = Nothing
    On Error GoTo 0
    Exit Sub

ErrorHandler:
    strMsg = "Error " & Err.Number & " (" & Err.Description _
        & ") in procedure CloseAllOtherAccess"
    MsgBox strMsg
    GoTo ExitHere
End Sub

It appears to me GetObject returns the "oldest" Access instance. So that sub closes all Access instances started before the one which is running the sub. Once it finds itself, it stops. Maybe that's fine for your situation. But if you need to also close Access instances started after the one which is running the code, look to Windows API window handle functions.

I didn't try this approach for Excel. But I did see Excel provides Application.Hwnd and Application.Hinstance ... so I suspect you can do something similar there.

Also, notice I got rid of On Error Resume Next. GetObject will always return an Application object in this sub, so it didn't serve any purpose. Additionally, I try to avoid On Error Resume Next in general.

Update: Since GetObject won't do the job for you, use a different method to get the window handles of all the Access instances. Close each of them whose window handle doesn't match the one you want to leave running (Application.hWndAccessApp).

Public Sub CloseAllAccessExceptMe()
'FindWindowLike from: '
'How To Get a Window Handle Without Specifying an Exact Title '
'http://support.microsoft.com/kb/147659 '

'ProcessTerminate from: '
'Kill a Process through VB by its PID '
'http://en.allexperts.com/q/Visual-Basic-1048/Kill-Process-VB-its-1.htm '

    Dim lngMyHandle As Long
    Dim i As Long
    Dim hWnds() As Long

    lngMyHandle = Application.hWndAccessApp

    ' get array of window handles for all Access top level windows '
    FindWindowLike hWnds(), 0, "*", "OMain", Null

    For i = 1 To UBound(hWnds())
        If hWnds(i) = lngMyHandle Then
            Debug.Print hWnds(i) & " -> leave myself running"
        Else
            Debug.Print hWnds(i) & " -> close this one"
            ProcessTerminate , hWnds(i)
        End If
    Next i
End Sub