У меня была похожая проблема / цель.
И я получил рабочий ответ ForEachLoops, но есть изменение, которое необходимо сделать.
В нижней функции (GetExcelObjectFromHwnd) он использовал индекс рабочей книги 1 в обеих командах debug.print. В результате вы видите только первый WB.
Итак, я взял его код и поместил цикл for в GetExcelObjectFromHwnd и изменил 1 на счетчик. В результате я могу получить ВСЕ активные книги Excel и вернуть информацию, необходимую для доступа к экземплярам Excel, и получить доступ к другим WB.
И я создал Type, чтобы упростить извлечение информации и передать ее вызывающей подпрограмме:
Type TargetWBType
name As String
returnObj As Object
returnApp As Excel.Application
returnWBIndex As Integer
End Type
В качестве имени я просто использовал базовое имя файла, например, "Example.xls". Этот фрагмент подтверждает функциональность, выпуская значение A6 на каждой WS целевого WB. Вот так:
Dim targetWB As TargetWBType
targetWB.name = "example.xls"
Call GetAllWorkbookWindowNames(targetWB)
If Not targetWB.returnObj Is Nothing Then
Set targetWB.returnApp = targetWB.returnObj.Application
Dim ws As Worksheet
For Each ws In targetWB.returnApp.Workbooks(targetWB.returnWBIndex).Worksheets
MsgBox ws.Range("A6").Value
Next
Else
MsgBox "Target WB Not found"
End If
Так что теперь весь модуль, который изначально создавал ForEachLoop, выглядит следующим образом, и я указал на сделанные мной изменения. У него есть всплывающее окно msgbox, которое я оставил во фрагменте для целей отладки. Уберите это, как только он найдет вашу цель. Код:
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
'------------- Form Module --------------
Option Explicit
Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As Long = &HFFFFFFF0
'My code: added targetWB
Sub GetAllWorkbookWindowNames(targetWB As TargetWBType)
On Error GoTo MyErrorHandler
Dim hWndMain As Long
hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
Do While hWndMain <> 0
GetWbkWindows hWndMain, targetWB 'My code: added targetWB
hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
Loop
Exit Sub
MyErrorHandler:
MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
'My code: added targetWB
Private Sub GetWbkWindows(ByVal hWndMain As Long, targetWB As TargetWBType)
On Error GoTo MyErrorHandler
Dim hWndDesk As Long
hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)
If hWndDesk <> 0 Then
Dim hWnd As Long
hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)
Dim strText As String
Dim lngRet As Long
Do While hWnd <> 0
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
If Left$(strText, lngRet) = "EXCEL7" Then
GetExcelObjectFromHwnd hWnd, targetWB 'My code: added targetWB
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
'My code: added targetWB
Public Function GetExcelObjectFromHwnd(ByVal hWnd As Long, targetWB As TargetWBType) As Boolean
On Error GoTo MyErrorHandler
Dim fOk As Boolean
fOk = False
Dim iid As UUID
Call IIDFromString(StrPtr(IID_IDispatch), iid)
Dim obj As Object
If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
Dim objApp As Excel.Application
Set objApp = obj.Application
'My code
Dim wbCount As Integer
For wbCount = 1 To objApp.Workbooks.Count
'End my code
'Not my code
Debug.Print objApp.Workbooks(wbCount).name
'My code
If LCase(objApp.Workbooks(wbCount).name) = LCase(targetWB.name) Then
MsgBox ("Found target: " & targetWB.name)
Set targetWB.returnObj = obj
targetWB.returnWBIndex = wbCount
End If
'End My code
'Not my code
Dim myWorksheet As Worksheet
For Each myWorksheet In objApp.Workbooks(wbCount).Worksheets
Debug.Print " " & myWorksheet.name
DoEvents
Next
'My code
Next
'Not my code
fOk = True
End If
GetExcelObjectFromHwnd = fOk
Exit Function
MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function
Я повторяю, это работает, и используя переменные в типе TargetWB, я надежно получаю доступ к рабочим книгам и рабочим листам во всех экземплярах Excel.
Единственная потенциальная проблема, которую я вижу с моим решением, это если у вас есть несколько ББ с одним и тем же именем. Прямо сейчас, я верю, что это вернет последний экземпляр этого имени. Если мы добавим Exit For в If Then, я верю, что вместо этого он вернет первый экземпляр. Я тщательно не тестировал эту часть, так как в моем приложении всегда был только один экземпляр открытого файла.