Aus Excel-VBA andere Excel-Instanzen killen

[Jumpy]

OK, hab's mit ein paar Tipps aus einem anderen Thread hier hinbekommen. Vllt. kann ja wer es mal irgendwann brauchen.

Code:

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