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

Answer 1

try putting it in a loop

Set ObjXL = GetObject(, "Excel.Application")
do until ObjXL Is Nothing
        Debug.Print "Closing XL"
        ObjXL.Application.DisplayAlerts = False
        ObjXL.Workbooks.Close
        ObjXL.Quit
        Set ObjXL = Nothing
        Set ObjXL = GetObject(, "Excel.Application")  ' important!
loop

Answer 2

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

Answer 3

I know this is an old post but for those who visit here from searches may find it helpful. This code was found and modified. It will give you every SHEET in every WORKBOOK in every INSTANCE. From there you can determine the active instance.

Module..............

Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long

Type UUID 'GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Code…………………...

Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub ListAll()
    Dim I As Integer
    Dim hWndMain As Long
    On Error GoTo MyErrorHandler
        hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
        I = 1
        Do While hWndMain <> 0
            Debug.Print "Excel Instance " & I
            GetWbkWindows hWndMain
            hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
            I = I + 1
        Loop
        Exit Sub
    MyErrorHandler:
    MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub

Sub GetWbkWindows(ByVal hWndMain As Long)
    Dim hWndDesk As Long
    Dim hWnd As Long
    Dim strText As String
    Dim lngRet As Long
    On Error GoTo MyErrorHandler     
        hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)
        If hWndDesk <> 0 Then
            hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString) 
            Do While hWnd <> 0
                strText = String$(100, Chr$(0))
                lngRet = GetClassName(hWnd, strText, 100)
                If Left$(strText, lngRet) = "EXCEL7" Then
                    GetExcelObjectFromHwnd hWnd
                    Exit Sub
                End If
                hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString)
            Loop
            On Error Resume Next
        End If
            Exit Sub
    MyErrorHandler:
        MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub

Function GetExcelObjectFromHwnd(ByVal hWnd As Long) As Boolean
    Dim fOk As Boolean
    Dim I As Integer
    Dim obj As Object
    Dim iid As UUID
    Dim objApp As Excel.Application
    Dim myWorksheet As Worksheet
    On Error GoTo MyErrorHandler        
        fOk = False
        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
            Set objApp = obj.Application
            For I = 1 To objApp.Workbooks.Count
                Debug.Print "     " & objApp.Workbooks(I).Name
                For Each myWorksheet In objApp.Workbooks(I).Worksheets
                    Debug.Print "          " & myWorksheet.Name
                    DoEvents
                Next
                fOk = True
            Next I
        End If
        GetExcelObjectFromHwnd = fOk
        Exit Function
    MyErrorHandler:
        MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function

I hope this helps someone :)

Answer 4

I just tried the following with both Excel and Access :

Dim sKill As String

sKill = "TASKKILL /F /IM msaccess.exe"
Shell sKill, vbHide

If you change the msaccess.exe to excel.exe, excel will be killed.

If you want a bit more control over the process, check out:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=811

Answer 5

Differentiating open instances of an application is a very old problem, and it is not unique to VBA.

I've tried to figure this out myself over the years, never with greater success than the time before.

I think the long and short of it is that you can never know if the application instance you're referencing is the one in which the code is executing (so terminating it might leave other instances open).

Answer 6

This is a response to an old post, but same as the poster in 2012, hopefully it helps someone who may come here based on a generic web search.

Background My company uses XLSX "models" to turn our data into "pretty" automatically. The data exports from SAS as XLS; we do not have the licensing or add-ons to export as XLSX. The normal process is to copy/paste each of the 14 SAS outputs into the XLSX. The code below iterates through the first two exports where data is copied from the XLS, pasted into the XLSX, and the XLS closed.

Please note: The XLSX file is saved to the hard drive. The XLS files are NOT SAVED, i.e. the path goes to "My Documents/" but there is no file name or file visible there.

Sub Get_data_from_XLS_to_XLSX ()
    Dim xlApp1 As Excel.Application
    Dim xlApp2 As Excel.Application

'Speed up processing by turning off Automatic Calculations and Screen Updating
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False


'Copies data from Book1 (xls) and pastes into ThisWorkbook (xlsx), then closes xls file
    Set xlApp1 = GetObject("Book1").Application

    xlApp1.Workbooks("Book1").Sheets("Sheet1").Range("A2:E2").Copy
    Application.ThisWorkbook.Worksheets("Data1").Cells(5, 2).PasteSpecialPaste:=xlPasteValues

'Clears the clipboard, turns off the "do you want to save" alert, closes xls file
    xlApp1.CutCopyMode = False
    xlApp1.DisplayAlerts = False
    xlApp1.Quit
    xlApp1.DisplayAlerts = True



'Same as the first one above, but now it's a second/different xls file, i.e. Book2
    Set xlApp2 = GetObject("Book2").Application

    xlApp2.Workbooks("Book2").Sheets("Sheet1").Range("A2:E2").Copy
    Application.ThisWorkbook.Sheets("Data2").Cells(10, 2).PasteSpecial Paste:=xlPasteValues

'Clears the clipboard, turns off the "do you want to save" alert, closes xls file
    xlApp2.CutCopyMode = False
    xlApp2.DisplayAlerts = False
    xlApp2.Quit
    xlApp2.DisplayAlerts = True


'Sub continues for 12 more iterations of similar code
End Sub

You need to be explicit in qualifying your statements. i.e. instead of Workbooks("Book_Name") make sure you identify the application you are referring to, be it Application.Workbooks("Book_Name") or xlApp1.Workbooks("Book_Name")