在Excel的一个实例中运行的Excel VBA宏是否可以访问另一个正在运行的Excel实例的工作簿?例如,我想创建一个在任何正在运行的Excel实例中打开的所有工作簿的列表。VBA可以跨越Excel的实例吗?
回答
科尼利厄斯的答案是部分正确的。他的代码获取当前实例,然后创建一个新实例。 GetObject只有获得第一个实例,无论有多少实例可用。我相信的问题是如何从多个实例中获得特定的实例。
对于VBA项目,使用一个名为Command1的命令按钮创建两个模块,一个代码模块,另一个作为窗体。您可能需要添加对Microsoft.Excel的引用。
此代码显示立即窗口中每个正在运行的Excel实例的每个工作簿的所有名称。
'------------- Code Module --------------
Option Explicit
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
'Sub GetAllWorkbookWindowNames()
Sub Command1_Click()
On Error GoTo MyErrorHandler
Dim hWndMain As Long
hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
Do While hWndMain <> 0
GetWbkWindows hWndMain
hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
Loop
Exit Sub
MyErrorHandler:
MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
Private Sub GetWbkWindows(ByVal hWndMain As Long)
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
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
Public Function GetExcelObjectFromHwnd(ByVal hWnd As Long) 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
Debug.Print objApp.Workbooks(1).Name
Dim myWorksheet As Worksheet
For Each myWorksheet In objApp.Workbooks(1).Worksheets
Debug.Print " " & myWorksheet.Name
DoEvents
Next
fOk = True
End If
GetExcelObjectFromHwnd = fOk
Exit Function
MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function
仅供参考,Microsoft Access的类名是'OMain'。我修改了这段代码,可以轻松识别开放的Microsoft Access数据库。 – AdamsTips 2017-10-27 22:12:37
我不相信这是可能的只使用VBA,因为您可以访问的最高级别的对象是应用程序对象,它是当前的Excel实例。
我相信VBA比查尔斯认为更强大;)
如果只有从GetObject and CreateObject指向特定实例一些棘手的方式,我们将有你的问题解决了!
编辑:
如果你是所有实例的创建者应该有事情像上市工作簿没有任何问题。看看这个代码:
Sub Excels()
Dim currentExcel As Excel.Application
Dim newExcel As Excel.Application
Set currentExcel = GetObject(, "excel.application")
Set newExcel = CreateObject("excel.application")
newExcel.Visible = True
newExcel.Workbooks.Add
'and so on...
End Sub
我认为,在VBA内,你可以访问应用程序对象在另一个运行实例。如果您知道在其他实例中打开的工作簿的名称,则可以获取对该应用程序对象的引用。见Allen Waytt's page
最后一部分,
Dim xlApp As Excel.Application
Set xlApp = GetObject("c:\mypath\ExampleBook.xlsx").Application
让我得到一个指针,有ExampleBook.xlsx
开放实例的应用对象。
我相信“ExampleBook”必须是完整的路径,至少在Excel 2010中。我目前正在尝试这个,所以我会尝试更新,因为我会得到更多的细节。
如果单独的实例打开相同的工作簿,但只有一个可能具有写入访问权限,则可能会有复杂情况发生。
当我使用完整路径时,+1为我工作了一个vbs,http://stackoverflow.com/questions/20849853/running-vbscript-function-from-vba/20850129#20850129 – brettdj 2014-01-01 09:25:05
我有一个类似的问题/目标。
而且我得到了ForEachLoops答案,但是需要做出改变。 在底层函数(GetExcelObjectFromHwnd)中,他在两个debug.print命令中都使用1的工作簿索引。结果是你只能看到第一个WB。
所以我拿了他的代码,并在GetExcelObjectFromHwnd中放置一个for循环,并将1更改为一个计数器。结果是我可以获得所有活动的Excel工作簿,并返回我需要跨Excel实例访问的信息并访问其他WB。
我创建了一个类型,以简化信息的检索,并将其传递回调用子程序:
Type TargetWBType
name As String
returnObj As Object
returnApp As Excel.Application
returnWBIndex As Integer
End Type
对于名字我只是用的基本文件名,例如“example.xls”。该片段通过在目标WB的每个WS上吐出A6的值来证明该功能。像这样:
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
所以现在整个模块foreach循环原先作出这个样子的,我已经表明我所做的更改。它有一个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的情况下,工作簿和工作表。
我在解决方案中看到的唯一潜在问题是如果您有多个具有相同名称的WB。现在,我相信它会返回该名称的最后一个实例。如果我们将Exit For添加到If中,那么我相信它会返回它的第一个实例。我没有完全测试这个部分,因为在我的应用程序中只有一个文件实例处于打开状态。
感谢这篇不错的文章,我有一个例程来查找返回当前在机器上运行的所有Excel应用程序的数组。麻烦的是,我刚刚升级到Office 2013 64位,它都出错了。
有一种将... Declare Function ...
转换为... Declare PtrSafe Function ...
的常用方法,这在其他地方已有很好的文档。但是,我无法找到任何文档是因为升级后原始代码期望的窗口层次结构('XLMAIN' - >'XLDESK' - >'EXCEL7')已更改。对于任何追随我的脚步的人来说,为了节省下午的时间,我想我会发布我的更新脚本。这很难测试,但我认为它应该向后兼容,以便采取更好的措施。
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" (ByVal lpsz As LongPtr, ByRef lpiid As UUID) As LongPtr
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal Hwnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As UUID, ByRef ppvObject As Object) As LongPtr
#Else
Private 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
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long
#End If
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 LongPtr = &HFFFFFFF0
' Run as entry point of example
Public Sub Test()
Dim i As Long
Dim xlApps() As Application
If GetAllExcelInstances(xlApps) Then
For i = LBound(xlApps) To UBound(xlApps)
If xlApps(i).Workbooks(1).Name <> ThisWorkbook.Name Then
MsgBox (xlApps(i).Workbooks(1).Name)
End If
Next
End If
End Sub
' Actual public facing function to be called in other code
Public Function GetAllExcelInstances(xlApps() As Application) As Long
On Error GoTo MyErrorHandler
Dim n As Long
#If Win64 Then
Dim hWndMain As LongPtr
#Else
Dim hWndMain As Long
#End If
Dim app As Application
' Cater for 100 potential Excel instances, clearly could be better
ReDim xlApps(1 To 100)
hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
Do While hWndMain <> 0
Set app = GetExcelObjectFromHwnd(hWndMain)
If Not (app Is Nothing) Then
If n = 0 Then
n = n + 1
Set xlApps(n) = app
ElseIf checkHwnds(xlApps, app.Hwnd) Then
n = n + 1
Set xlApps(n) = app
End If
End If
hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
Loop
If n Then
ReDim Preserve xlApps(1 To n)
GetAllExcelInstances = n
Else
Erase xlApps
End If
Exit Function
MyErrorHandler:
MsgBox "GetAllExcelInstances" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function
#If Win64 Then
Private Function checkHwnds(xlApps() As Application, Hwnd As LongPtr) As Boolean
#Else
Private Function checkHwnds(xlApps() As Application, Hwnd As Long) As Boolean
#End If
Dim i As Integer
For i = LBound(xlApps) To UBound(xlApps)
If xlApps(i).Hwnd = Hwnd Then
checkHwnds = False
Exit Function
End If
Next i
checkHwnds = True
End Function
#If Win64 Then
Private Function GetExcelObjectFromHwnd(ByVal hWndMain As LongPtr) As Application
#Else
Private Function GetExcelObjectFromHwnd(ByVal hWndMain As Long) As Application
#End If
On Error GoTo MyErrorHandler
#If Win64 Then
Dim hWndDesk As LongPtr
Dim Hwnd As LongPtr
#Else
Dim hWndDesk As Long
Dim Hwnd As Long
#End If
Dim strText As String
Dim lngRet As Long
Dim iid As UUID
Dim obj As Object
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 = CLng(GetClassName(Hwnd, strText, 100))
If Left$(strText, lngRet) = "EXCEL7" Then
Call IIDFromString(StrPtr(IID_IDispatch), iid)
If AccessibleObjectFromWindow(Hwnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
Set GetExcelObjectFromHwnd = obj.Application
Exit Function
End If
End If
Hwnd = FindWindowEx(hWndDesk, Hwnd, vbNullString, vbNullString)
Loop
On Error Resume Next
End If
Exit Function
MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function
你应该根据你的具体情况创建另一个问题情况,然后回答。搜索的人不一定会在这里找到你的答案。 – guitarthrower 2015-02-13 17:15:21
我明白你的观点,但我觉得我正在解决原来的问题。自从问题被问到/回答以来,Excel已经开始发展,任何想要用今天的软件解决问题的人都需要做一些不同的事情。我提供了这个更新,这只是对原始答案的一个小调整。 – 2015-02-13 23:00:32
因为我也有excele 2°13 64bit,我只会在这里发表评论:在checkHwnds中发现错误:th循环必须停止在n而不是100,因此您需要将n作为参数传递给checkHwnds。 – 2017-10-28 15:32:42
我想补充詹姆斯MacAdie的答案,我想你做的REDIM为时已晚,因为在checkHwnds工作,你结束了一个超出范围的错误你尽力检查值高达100,即使你还没有完全填充阵列?我修改了下面的代码,现在它适用于我。
' Actual public facing function to be called in other code
Public Function GetAllExcelInstances(xlApps() As Application) As Long
On Error GoTo MyErrorHandler
Dim n As Long
#If Win64 Then
Dim hWndMain As LongPtr
#Else
Dim hWndMain As Long
#End If
Dim app As Application
' Cater for 100 potential Excel instances, clearly could be better
ReDim xlApps(1 To 100)
hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
Do While hWndMain <> 0
Set app = GetExcelObjectFromHwnd(hWndMain)
If Not (app Is Nothing) Then
If n = 0 Then
n = n + 1
ReDim Preserve xlApps(1 To n)
Set xlApps(n) = app
ElseIf checkHwnds(xlApps, app.Hwnd) Then
n = n + 1
ReDim Preserve xlApps(1 To n)
Set xlApps(n) = app
End If
End If
hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
Loop
If n Then
GetAllExcelInstances = n
Else
Erase xlApps
End If
Exit Function
MyErrorHandler:
MsgBox "GetAllExcelInstances" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function
- 1. RadioGroup可以跨越多个布局吗?
- 2. iOS支持可跨越字符串吗?
- 3. PredicateBuilder可以生成跨越多个表的谓词吗?
- 4. 跨越wcf的Nhibernate实体
- 5. 你可以让Facebook Connect应用跨越多页吗?
- 6. 我们可以跨越SQL服务器到多台机器吗
- 7. Excel VBA自动实例化的神话性能不佳吗?
- 8. 在Excel中使用VBA可以访问VBA代码吗?
- 9. 如何让跨越实例的Y.io全局事件广播
- 10. JBoss实例可以通信吗?
- 11. 可以StringBuilder替换一个实例吗?
- 12. @compatibility_alias可以调用实例方法吗?
- 13. 可以合并两个GraphQLSchema实例吗?
- 14. 类实例可以自毁吗?
- 15. Excel中的VBA函数可以返回一个范围吗?
- 16. 跨越
- 17. 跨越多个表的分层子查询可以引用父查询吗?
- 18. 我可以使矩阵行组跨越SSRS中的其子组吗?
- 19. Python的正则表达式可以防止用'\ s'跨越换行符吗?
- 20. 我可以在XML模式中表达“可能/不可以包含”跨越多个级别的规则吗?
- 21. 使用vba可以比较两个excel文件吗?
- 22. 我们可以使用.NET System.Windows.Forms.Timer来替换Excel VBA Application.onTime吗?
- 23. 我可以使用VBA从Python网站控制Excel文件吗?
- 24. 我可以在Excel 2010精简版中使用VBA吗?
- 25. 我可以在Excel 2010 VBA中执行异步XML调用吗?
- 26. Excel VBA:我可以设置全局右键单击事件吗?
- 27. Excel VBA中可以全局声明工作表对象吗?
- 28. 在子报表中,“Stretch with overflow”可以跨越多个页面吗?
- 29. 虚拟网络可以跨越天蓝色租户进行对等吗?
- 30. 拉伸以跨越家长的高度
“ForEachLoop”的答案应该是可接受的答案,并赋予“Flakker”功劳。 Cornelius提出的'GetObject'方法不能回答这个问题。 – brettdj 2014-01-01 04:05:41