Option Explicit
'--------------------------------------------------------------------------------------------
'
API-Declarations
'--------------------------------------------------------------------------------------------
Public Declare Function ApiFindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As String) As Long
Public Declare Function ApiGetDesktopWindow Lib "user32" _
Alias "GetDesktopWindow" () As Long
Public Declare Function ApiFindWindowExtended Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function ApiAccessibleObject Lib "oleacc" _
Alias "AccessibleObjectFromWindow" (ByVal hwnd As Long, _
ByVal dwId As Long, _
ByRef riid As apiUUID, _
ByRef ppvObject As Object) _
As Long
Private Declare Function ApiIIDFromString Lib "ole32" _
Alias "IIDFromString" (ByVal lpsz As Long, _
ByRef lpiid As apiUUID) As Long
Public Declare Function ApiEnumChildWindows Lib "user32" _
Alias "EnumChildWindows" (ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Public Declare Function ApiGetParent Lib "user32" _
Alias "GetParent" (ByVal hwnd As Long) As Long
Public Declare Function ApiGetClassName Lib "user32" _
Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
'--------------------------------------------------------------------------------------------
'Types
'--------------------------------------------------------------------------------------------
Private Type apiUUID
a As Long
b As Integer
c As Integer
d(7) As Byte
End Type
'--------------------------------------------------------------------------------------------
'Constants & global Variables
'--------------------------------------------------------------------------------------------
Private Const PROCESS_TERMINATE = &H1
Private Const mlchObjIDNativeOM As Long = &HFFFFFFF0
Private Const Key As String = "{00020893-0000-0000-C000-000000000046}"
Dim ChildHandles As Collection
'--------------------------------------------------------------------------------------------
'
API-Related-Functions
'--------------------------------------------------------------------------------------------
Public Function ApiAccessibleObjectCreate(ByVal
Handle As Long, Key As String, Data As Object) As Boolean
Dim e As Long
Dim r As Boolean
Dim o As Object
Dim t As apiUUID
On Error Resume Next
e = ApiIIDFromString(StrPtr(Key), t)
e = ApiAccessibleObject(
Handle, mlchObjIDNativeOM, t, o)
If Not e <> 0 Then
Set Data = o.Application
r = Not CBool(Err.Number <> 0)
Else
r = False
End If
ApiAccessibleObjectCreate = r
End Function
Private Function ChildEnumerator(
Handle As Long) As Long
Dim r As Long
On Error Resume Next
r = ApiEnumChildWindows(
Handle, AddressOf Child, 0)
ChildEnumerator = r
End Function
Private Function Child(ByVal
Handle As Long, _
ByVal Params As Long) As Long
Dim h As Long
On Error Resume Next
h = ApiGetParent(
Handle)
If h <> 0 Then ChildHandles.Add
Handle
Child = True
End Function
'--------------------------------------------------------------------------------------------
'Functions
'--------------------------------------------------------------------------------------------
'Close all workbooks of the current Excel-Application / the current instance
Sub CloseAllWorkbooks(AskUser As Boolean)
Dim wbn As String, wb As Workbook
wbn = ThisWorkbook.Name
For Each wb In Application.Workbooks
If wb.Name <> wbn Then
If AskUser Then
If MsgBox("Es ist noch das Workbook """ & wb.Name & """ offen." & vbCrLf & _
"Soll es geschlossen werden?", vbQuestion + vbYesNo) = vbYes Then wb.Close
Else
wb.Close
End If
End If
Next wb
End Sub
'Close all workbooks of a given Excel-Application / -Instance
Sub CloseApplicationWorkbooks(ex As Excel.Application, AskUser As Boolean)
Dim wbn As String, wb As Workbook
If ex = ThisWorkbook.Application Then wbn = ThisWorkbook.Name Else wbn = ""
For Each wb In ex.Workbooks
If wb.Name <> wbn Then
If AskUser Then
If MsgBox("Es ist noch das Workbook """ & wb.Name & """ offen." & vbCrLf & _
"Soll es geschlossen werden?", vbQuestion + vbYesNo) = vbYes Then wb.Close
Else
wb.Close
End If
End If
Next wb
End Sub
'Function, to get the window
handle of the current Excel-Application / -Instance
Function GetHandle() As Long
If InStr(Left(Application.Version, 2), ".") > 0 Then
GetHandle = GetOldHandle
Else
GetHandle = self.hwnd
End If
End Function
'Sub-Function, to get the window hanlde of the current Instance for older (<2002) Excel versions
Function GetOldHandle() As Long
Dim OldCap As String
OldCap = Application.Caption
Application.Caption = "ABCDEFGHIJKLMNOP"
GetOldHandle = ApiFindWindow("XLMAIN", Application.Caption)
Application.Caption = OldCap
End Function
'Find all Excel-Instances
Sub ApplicationFinder()
Dim Desktophandle As Long
Dim h As Long
Dim
Handle() As Long
Dim n, i As Integer
Dim v As Variant
n = 0
Desktophandle = ApiGetDesktopWindow
'Find hanldes and save in array
Do
h = ApiFindWindowExtended(Desktophandle, h, "XlMain", vbNullString)
If h <> 0 And h <> GetHandle Then
n = n + 1
ReDim Preserve
Handle(n)
Handle(n) = h
End If
Loop While h <> 0
'For every
handle/instance: Get children and call the Kill-Procedure
For i = 1 To n
Set ChildHandles = New Collection
ChildEnumerator
Handle(i)
KillApplikation
Handle(i)
Set ChildHandles = Nothing
Next
End Sub
'Kill application from the given
handle
Sub KillApplikation(
Handle As Long)
Dim App As Object
Dim v As Variant
Dim t As Long, PID As Long
Dim lhwnd As Long, lResult As Long
'If possible, get
access to instance and close all workbooks
For Each v In ChildHandles
If ApiAccessibleObjectCreate(v, Key, App) Then
CloseApplicationWorkbooks App, True
Exit For
End If
Next
'Get and kill Prozess
t = GetWindowThreadProcessId(
Handle, PID)
lhwnd = OpenProcess(PROCESS_TERMINATE, 0&, PID)
lResult = TerminateProcess(lhwnd, 1&)
lResult = CloseHandle(lhwnd)
End Sub
'--------------------------------------------------------------------------------------------
'Possible Call
'--------------------------------------------------------------------------------------------
Sub Test()
Dim e As Excel.Application
Dim w As Workbook, wb As Workbook
On Error Resume Next
Set e = New Excel.Application
Set w = e.Workbooks.Open("C:\Test.xls")
'The created Application and workbook are abandoned, to create a "ghost" application
'w.Close
'Set w = Nothing
'Set e = Nothing
ApplicationFinder
End Sub