VBA Tipp: Anwendung schließen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich will alle Fenster einer Anwendungsklasse schließen - z.B. alle Access-Fenster oder alle Word-Fenster. Oder: Ich will alle Fenster mit einem bestimmten Fenster-Titel (wie z.B. "Microsoft Access") schließen.

Lösung

Die folgende Routine KillAllAppsByClass sendet eine CLOSE-Nachricht an die Fenster der angegebenen Windows-Klasse, die Routine KillAllAppsByCaption an die Fenster mit dem angegebenen Titel.

Zu gängigen Windows-Klassen siehe den Artikel VBA Tipp: Anwendungsfenster zählen.

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" _
  (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
  (ByVal hWnd As Long, ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
  (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
  (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
   LParam As Any) As Long
 
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_CLOSE = &H10
 
Public Function KillAllAppsByClass _
 (Optional BesidesThisOne As Boolean = True, _
  Optional ClassName = "OMain")
'
'   Schliesst alle Anwendungsfenster einer Windows-Klasse
'
Dim hWnd As Long, tbuf As String, RetVal As Long
  hWnd = GetDesktopWindow()
  hWnd = GetWindow(hWnd, GW_CHILD)
  Do While hWnd <> 0
    tbuf = String(255, 0)
    RetVal = GetClassName(hWnd, tbuf, Len(tbuf))
    If Mid(tbuf, 1, RetVal) = ClassName Then
      If Not BesidesThisOne Or hWnd <> Application.hWndAccessApp Then
        PostMessage hWnd, WM_CLOSE, 0&, 0&
      End If
    End If
    hWnd = GetWindow(hWnd, GW_HWNDNEXT) ' nächstes Fenster
  Loop
End Function
 
Public Function KillAllAppsByCaption _
 (Optional BesidesThisOne As Boolean = True, _
  Optional Caption = "Microsoft Access")
'
'  Schliesst alle Anwendungsfenster mit einem bestimmten Titel
'  (Nur der Anfang des Titels in der spezifizierten Länge wird
'   untersucht, d.h., der tatsächliche Titel kann länger sein).
'
Dim hWnd As Long, tbuf As String, RetVal As Long
  hWnd = GetDesktopWindow()
  hWnd = GetWindow(hWnd, GW_CHILD)
  Do While hWnd <> 0
    tbuf = String(255, 0)
    RetVal = GetWindowText(hWnd, tbuf, Len(tbuf))
    If RetVal > Len(Caption) Then RetVal = Len(Caption) ' ggf. abschneiden
    If Mid(tbuf, 1, RetVal) = Caption Then
      If Not BesidesThisOne Or hWnd <> Application.hWndAccessApp Then
        PostMessage hWnd, WM_CLOSE, 0&, 0&
      End If
    End If
    hWnd = GetWindow(hWnd, GW_HWNDNEXT) ' nächstes Fenster
  Loop
End Function

Aufruf

KillAllAppsByClass

schließt alle Access-Fenster bis auf das aktuelle,

KillAllAppsByClass ,"OpusApp"

schließt alle Word-Fenster.

KillAllAppsByCaption True,"Microsoft Spy++"

schließt Spy++.


Wiki hinweis.png Anmerkung: Nicht immer und zu jeder Zeit wird sich jedes Fenster schließen lassen - da hilft dann oft nur Handarbeit.