Я знаю, что это старый пост, но для тех, кто посещает здесь с поисков, может оказаться полезным.Этот код был найден и изменен.Это даст вам каждый ЛИСТ в каждой РАБОЧЕЙ КНИГЕ в каждом МОМЕНТЕ.Оттуда вы можете определить активный экземпляр.
Модуль ..............
Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long
Type UUID 'GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Код ………………… ...
Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As Long = &HFFFFFFF0
Sub ListAll()
Dim I As Integer
Dim hWndMain As Long
On Error GoTo MyErrorHandler
hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
I = 1
Do While hWndMain <> 0
Debug.Print "Excel Instance " & I
GetWbkWindows hWndMain
hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
I = I + 1
Loop
Exit Sub
MyErrorHandler:
MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
Sub GetWbkWindows(ByVal hWndMain As Long)
Dim hWndDesk As Long
Dim hWnd As Long
Dim strText As String
Dim lngRet As Long
On Error GoTo MyErrorHandler
hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)
If hWndDesk <> 0 Then
hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)
Do While hWnd <> 0
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
If Left$(strText, lngRet) = "EXCEL7" Then
GetExcelObjectFromHwnd hWnd
Exit Sub
End If
hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString)
Loop
On Error Resume Next
End If
Exit Sub
MyErrorHandler:
MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
Function GetExcelObjectFromHwnd(ByVal hWnd As Long) As Boolean
Dim fOk As Boolean
Dim I As Integer
Dim obj As Object
Dim iid As UUID
Dim objApp As Excel.Application
Dim myWorksheet As Worksheet
On Error GoTo MyErrorHandler
fOk = False
Call IIDFromString(StrPtr(IID_IDispatch), iid)
If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
Set objApp = obj.Application
For I = 1 To objApp.Workbooks.Count
Debug.Print " " & objApp.Workbooks(I).Name
For Each myWorksheet In objApp.Workbooks(I).Worksheets
Debug.Print " " & myWorksheet.Name
DoEvents
Next
fOk = True
Next I
End If
GetExcelObjectFromHwnd = fOk
Exit Function
MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function
Надеюсь, это кому-нибудь поможет:)