AW: Schließen des Basisfensters
19.10.2020 18:15:11
volti
Hallo Hans-Jürgen,
vielleicht kannst Du mit nachfolgendem Code als Anregung etwas anfangen...
Er ermittelt alle vorhandenen Instanzen und gibt auch die Instanz des gesuchten Workbooks zurück.
Code:
[Cc][+][-]
Option Explicit
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
Erase hWndChild: iChildCount = 0 'Variablen zurücksetzen
Erase hWwndMain: iWindowCount = 0
Call IIDFromString(StrConv(IID_EXCELWINDOW, vbUnicode), udtGuid)
Call EnumWindows(AddressOf EnumWindowProc, ByVal 0&)
For i = LBound(hWwndMain) To UBound(hWwndMain)
Call EnumChildWindows(hWwndMain(i), _
AddressOf EnumChildWindowProc, ByVal 0&)
Next i
'Alle Kinder-Fenster durchgehen
sAllHandles = ","
For i = LBound(hWndChild) To UBound(hWndChild)
Call AccessibleObjectFromWindow(hWndChild(i), _
OBJID_NATIVEOM, udtGuid, oWin)
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
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 = "Archiv.xlsm"
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
MsgBox "Mappe '" & sSuch & "' ist ncht geöffnet!", vbInformation
End Sub
____________________
viele Grüße aus Freigericht
Karl-Heinz