Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindowExA Lib "user32" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
'-----------------------
'List of Excel Instances
'-----------------------
Sub ListExcelInstances()
Dim InstanceActiveWindowHandlesCollection As Collection
Dim TabInstanceWindowHandlesCollection() As Collection
Dim i As Integer
Dim k As Integer
Dim S As String
Call GetExcelInstances(InstanceActiveWindowHandlesCollection, TabInstanceWindowHandlesCollection)
For i = 1 To InstanceActiveWindowHandlesCollection.Count
With InstanceActiveWindowHandlesCollection(i).Application
S = S & vbCrLf & _
"Instance #" & i & ":" & vbCrLf
S = S & vbTab & "- Active Application " & .hWnd & vbCrLf
S = S & TabInstanceWindowHandlesCollection(i).Count & " Window(s):" & vbCrLf
For k = 1 To TabInstanceWindowHandlesCollection(i).Count
S = S & vbTab & _
k & "- Application " & TabInstanceWindowHandlesCollection(i)(k) & vbCrLf
Next k
S = S & .Workbooks.Count & " Workbook(s):" & vbCrLf
For k = 1 To .Workbooks.Count
S = S & vbTab & _
k & "- Workbook " & .Workbooks(k).Name & vbCrLf
Next k
End With
Next i
MsgBox S
End Sub
'---------------------------------------------------------------------------------
'Get Excel Instances
'- InstanceActiveWindowHandlesCollection -> Active Application of the Instances
'- TabInstanceWindowHandlesCollection() -> Application Window Handles per Instance
'---------------------------------------------------------------------------------
Private Sub GetExcelInstances(InstanceActiveWindowHandlesCollection As Collection, TabInstanceWindowHandlesCollection() As Collection)
#If VBA7 Then
Dim InstanceActiveApplicationHandle As LongPtr
Dim hWnd As LongPtr
Dim hWnd2 As LongPtr
Dim hWnd3 As LongPtr
#Else
Dim InstanceActiveApplicationHandle As Long
Dim hWnd As Long
Dim hWnd2 As Long
Dim hWnd3 As Long
#End If
Dim IntanceIndexCollection As Collection
Dim Index As Integer
Dim NbInstances As Integer
Dim ErrNumber As Long
Dim AccessibleObject As Object
Dim Guid(0 To 3) As Long
Guid(0) = &H20400
Guid(1) = &H0
Guid(2) = &HC0
Guid(3) = &H46000000
Set InstanceActiveWindowHandlesCollection = New Collection
Set IntanceIndexCollection = New Collection
Do
hWnd = FindWindowExA(0, hWnd, "XLMAIN", vbNullString)
If hWnd = 0 Then Exit Do
hWnd2 = FindWindowExA(hWnd, 0, "XLDESK", vbNullString)
hWnd3 = FindWindowExA(hWnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hWnd3, &HFFFFFFF0, Guid(0), AccessibleObject) = 0 Then
InstanceActiveApplicationHandle = AccessibleObject.Application.hWnd
On Error Resume Next
Index = IntanceIndexCollection.Item(CStr(InstanceActiveApplicationHandle))
ErrNumber = Err.Number
On Error GoTo 0
'Existing Instance
If ErrNumber = 0 Then
'Add the Application Window Handle to the Window Handles Collection
TabInstanceWindowHandlesCollection(Index).Add AccessibleObject.hWnd
'New Instance
Else
'Add the Active Application to the Instances Collection
InstanceActiveWindowHandlesCollection.Add AccessibleObject.Application
'
NbInstances = NbInstances + 1
ReDim Preserve TabInstanceWindowHandlesCollection(1 To NbInstances)
Set TabInstanceWindowHandlesCollection(NbInstances) = New Collection
IntanceIndexCollection.Add Item:=NbInstances, Key:=CStr(InstanceActiveApplicationHandle)
'Add the Application Window Handle to the Window Handles Collection
TabInstanceWindowHandlesCollection(NbInstances).Add AccessibleObject.hWnd
End If
End If
Loop
End Sub
