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