Aus Excel-VBA andere Excel-Instanzen killen

[Jumpy]

Hallo,
ich soll eine Klasse/Funktion (Excel-VBA) was auch immer erstellen, die Checked, ob andere Excel-Instanzen als die, in der die Funktion läuft, existieren und diese ggf. killed. Ich wollte mal mein geplantes vorgehen beschreiben, vllt. hat jemande Ideen was wie geht.

1) Alle Workbooks der aktuellen Instanz schließen, bis auf das, in dem die Funktion läuft. ERLEDIGT!

2) Da ich über Window-Handle arbeiten will erstmal den der aktuellen Instanz feststellen:
2a) Excel >= Excel 2002: self.hwnd ERLEDIGT!
2b) Was bei älteren Excel (2000 reicht, 97 wird nicht berücksichtigt)

3) Alle Excel-Instanzen über ihre Windows-Handle ermitteln. Will hiernach vorgehen:
http://www.excel-ticker.de/excel-vba...zeugen-teil-1/

4) Hat eine so gefundene Excel-Instanz einen anderen Handle als den gespeicherten, ist es mMn eine andere Instanz.
4a) Hat diese ein Workbook offen, so läßt sich (wie im Link unter 3 beschrieben) eine Objektreferenz auf dieses Workbook besorgen, dessen Application Eigenschaft dann eine Referenz auf die Instanz bildet. So könnte man dort alle Workbooks schließen und die Instanz killen (hoffe) ich.
4b) Ist kein Workbook offen ist im Teil 2 des verlinkten Titels eine Methode beschrieben ein Workbook zu erstellen und dann wie unter 4a weiterzumachen. Keine Ahnung ob das klappt.
4c) Ist diese Instanz ein abgestürztes Excel könnte 4b) nicht Möglich sein, was mach ich dann? Kill Prozess nach Name könnte in die Hose gehen, da alle Instanzen irgendwie Excel heißen. Gibts Kill nach Handle?


Denn gerade 4c) ist der Knackpunkt, da das abgestürzte Excel evtl. noch den Finger auf einem benötigten Dokument haben könnte, was dazu führt, dass die momentane Verarbeitung zu einem späteren Zeitpunkt scheitert.

P.S.: Werd das auch mal mit wenig Hoffnung in einem Excel-Forum posten, hab da aber wenig Hoffung, weil das so "gefühlt ans Windows-Eingemachte geht", sprich viel über APIs und da hab ich die Hoffnung das einige Programmierer hier da vllt. mehr Ahnung haben, als der normale Excel-VBA-Trickser (zu denen zähle ich mich auch und obigen Artkel hab ich auch beim dritten lesen nicht 100% verstanden).

Zum Crosspost: http://www.office-loesung.de/ftopic4...sc.php#2013765

[Jumpy]

Hallo,

für 2b) hab ich mir aus im Netz gefundenes was zusammengebaut:

Code:

'Benötigte API-Funktion deklarieren:
Public Declare Function mlfpApiFindWindow Lib "user32" _
          Alias "FindWindowA" (ByVal lpClassName As Any, _
                               ByVal lpWindowName As String) As Long

'Funktion, um das Hanlde der aktuellen Instanz zu erlangen
Function GetHandle() As Long
  If InStr(Left(Application.Version, 2), ".") > 0 Then
    GetHandle = GetOldHandle
  Else
    GetHandle = self.hwnd
  End If
End Function

'Hilfs-Funktion, um das Hanlde der aktuellen Instanz bei älteren Office-Versionen zu erlangen
Function GetOldHandle() As Long
  Dim OldCap As String
  OldCap = Application.Caption
  Application.Caption = "ABCDEFGHIJKLMNOP"
  
  GetOldHandle = mlfpApiFindWindow("XLMAIN", Application.Caption)
  Application.Caption = OldCap
End Function

'Testaufruf
Sub Test
  MsgBox GetHandle
End Sub

[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