AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Aus Excel-VBA andere Excel-Instanzen killen

Aus Excel-VBA andere Excel-Instanzen killen

Ein Thema von Jumpy · begonnen am 1. Sep 2011 · letzter Beitrag vom 5. Sep 2011
Antwort Antwort
Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.733 Beiträge
 
Delphi 6 Enterprise
 
#1

Aus Excel-VBA andere Excel-Instanzen killen

  Alt 1. Sep 2011, 16:42
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
Ralph

Geändert von Jumpy ( 1. Sep 2011 um 16:47 Uhr) Grund: Crosspost hinzugefügt
  Mit Zitat antworten Zitat
Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.733 Beiträge
 
Delphi 6 Enterprise
 
#2

AW: Aus Excel-VBA andere Excel-Instanzen killen

  Alt 2. Sep 2011, 11:36
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
Ralph

Geändert von Jumpy ( 2. Sep 2011 um 11:41 Uhr)
  Mit Zitat antworten Zitat
Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.733 Beiträge
 
Delphi 6 Enterprise
 
#3

AW: Aus Excel-VBA andere Excel-Instanzen killen

  Alt 5. Sep 2011, 10:30
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
Angehängte Dateien
Dateityp: zip ExcelInstanceChecker.zip (2,2 KB, 7x aufgerufen)
Ralph
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:04 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz