AW: Excel Sessions bleiben nach Abspielen von Makros offen?
19.02.2025 16:58:01
volti
Hallo Chris,
wenn es hier, wie zu vermuten ist, verschiedene Excel-Instanzen sind, sollte man diese auch alle durchgehen und die nicht gewünschten Dateien und Instanzen schließen.
Hier in meiner Bastelkiste ist ein VBA-Programm, das ich mal erstellt hatte, um eine offene Datei in allen Instanzen zu suchen. Das kann man sicher leicht umbauen (Sub SucheOffeneExcelmappe), um außer der gewünschten Datei alles zu schließen.
Hier erst mal eine Anregung dazu. Ist viel Code, aber wenn man es öfter braucht und man es nicht selbst erfinden muss, geht es m.E..
Code:
Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Sub IIDFromString Lib "ole32.dll" ( _
ByVal lpsz As String, ByRef lpiid As GUID)
Private Declare PtrSafe Sub AccessibleObjectFromWindow Lib "oleacc.dll" ( _
ByVal hWnd As LongPtr, ByVal dwId As Long, _
ByRef riid As GUID, ByRef ppvObject As Any)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Const IID_EXCELWINDOW = "{00020893-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private hWndChild() As LongPtr, iChildCount As Long
Private hWwndMain() As LongPtr, iWindowCount As Long
Private sAllHandles As String
Private Function GetApplications() As Application()
Dim i As Long, iCount As Long
Dim udtGuid As GUID, oWin As Window
Dim oTmpApplications() As Application
' Variablen zurücksetzen
Erase hWndChild: iChildCount = 0
Erase hWwndMain: iWindowCount = 0
' Konvertiere die IID des Excel-Window-Objektes in die GUID-Struktur
Call IIDFromString(StrConv(IID_EXCELWINDOW, vbUnicode), udtGuid)
' Alle geladenen Eltern-Fenster ermitteln
Call EnumWindows(AddressOf EnumWindowProc, ByVal 0&)
' Alle gefundenen Eltern-Excelfenster durchgehen
For i = LBound(hWwndMain) To UBound(hWwndMain)
' Alle Kinder-Fenster der gefundenen Elternfenster ermitteln
Call EnumChildWindows(hWwndMain(i), _
AddressOf EnumChildWindowProc, ByVal 0&)
Next i
' Alle Kinder-Fenster durchgehen
sAllHandles = ","
For i = LBound(hWndChild) To UBound(hWndChild)
' Hole über die Zugriffsnummer das entsprechende Window-Objekt
Call AccessibleObjectFromWindow(hWndChild(i), _
OBJID_NATIVEOM, udtGuid, oWin)
' Verweis setzen auf Application-Objekt
If Not oWin Is Nothing Then
If InStr(sAllHandles, "," & CStr(oWin.Application.hWnd) & ",") = 0 Then
ReDim Preserve oTmpApplications(iCount)
Set oTmpApplications(iCount) = oWin.Application
iCount = iCount + 1
sAllHandles = sAllHandles & CStr(oWin.Application.hWnd) & ","
End If
End If
Next i
' Array über die Functon zurückgeben
GetApplications = oTmpApplications
End Function
Private Function EnumWindowProc(ByVal hWnd As LongPtr, ByVal lParam As Long) As Long
'Durchlaufe alle Fenster und merke Excelfenster
Dim sClassname As String * 256
If Left$(sClassname, GetClassNameA(hWnd, sClassname, Len(sClassname))) _
= "XLMAIN" Then 'Ist es ein Excelfenster?
ReDim Preserve hWwndMain(iWindowCount) 'Array dimensionieren
hWwndMain(iWindowCount) = hWnd 'Fenster-Handle merken
iWindowCount = iWindowCount + 1 'Weiterzählen
End If
EnumWindowProc = 1
End Function
Private Function EnumChildWindowProc(ByVal hWnd As LongPtr, ByVal lParam As Long) As Long
'Durchlaufe alle Kinder-Fenster und merke Excelfenster
Dim sClassname As String * 256
If Left$(sClassname, GetClassNameA(hWnd, sClassname, Len(sClassname))) _
= "EXCEL7" Then
ReDim Preserve hWndChild(iChildCount) 'Array dimensionieren
hWndChild(iChildCount) = hWnd 'Fenster-Handle merken
iChildCount = iChildCount + 1 'Weiterzählen
EnumChildWindowProc = 0
Else
EnumChildWindowProc = 1
End If
End Function
Sub SucheOffeneExcelmappe()
Dim oApplications() As Application, WkB As Workbook
Dim i As Long
Dim sSuch As String
sSuch = "Excel-Instanzen.xlsb"
oApplications = GetApplications
For i = LBound(oApplications) To UBound(oApplications)
For Each WkB In oApplications(i).Workbooks
If WkB.Name Like sSuch Then
'Mach was.....
MsgBox "Workbook " & WkB.Name & " wurde gefunden!", vbInformation, "Excel-Instanzen"
' WkB.Close SaveChanges:=True 'Workbook schließen
' oApplications(i).Quit 'Diese Excel-Instanz beenden
Exit Sub
End If
Next WkB
Next i
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz
