VBA script to close every instance of Excel except itself - ms-access

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

Answer 2

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 3

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 4

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 5

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")

Answer 6

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