启动了多个 Excel 实例后,如何获取所有这些实例的应用程序对象?
Posted
技术标签:
【中文标题】启动了多个 Excel 实例后,如何获取所有这些实例的应用程序对象?【英文标题】:Having multiple Excel instances launched, how can I get the Application Object for all of them? 【发布时间】:2015-08-02 12:45:23 【问题描述】:我想使用类似的东西
GetObject(,"Excel.Application")
取回我创建的应用程序。
我调用CreateObject("Excel.Application")
来创建 Excel 实例。稍后如果 VBA 项目重置,由于调试和编码,应用程序对象变量会丢失,但 Excel 实例正在后台运行。有点内存泄漏的情况。
我想重新附加以重新使用(首选方式)或关闭它们。
【问题讨论】:
最好一开始就避免这个问题。见tushar-mehta.com/excel/vba/xl_doesnt_quit/index.htm 您发现发布的内容有用吗?请根据您的发现发布反馈、投票和/或接受。 以下 4 个答案均未正确回答该问题。最接近的是 Florent 的 answer,它列出了工作簿(即使在多个实例中),但没有确定是否实际上有多个实例正在运行,或者允许用户为每个实例获取Application
对象(至少就我而言可以告诉)。我还没有找到一种方法来实际列出实例的数量。澄清一下,instance 不仅仅是“另一个工作簿”;它实际上是在单独的内存部分等中运行进程。 . .
。 . .例如,可以通过holding ALT while opening a workbook 打开一个新的 Excel 实例,或者通过command line 启动 Excel,或者可以是来自 Microsoft 的forced for all workbooks with a registry tweak。
@ashleedawg 如果我理解,可以使用 xl.ActiveWorkbook.Application,另一个选项是 Florent B 从代码返回的完整路径文件字符串,可用于通过 GetObject 函数访问应用程序正如这里提出的***.com/a/46141767/6406135
【参考方案1】:
列出正在运行的 Excel 实例:
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
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
#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
Sub Test()
Dim xl As Application
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.ActiveWorkbook.FullName
Next
End Sub
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = 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), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function
【讨论】:
有用的东西,谢谢 :) 应该已经被 PO 接受了 非常酷的 +1,但需要澄清的是,这不是列出 Excel instances - 它是列出 Excel windows。例如,如果我有两个 Excel 实例,第一个打开了 2 个工作簿,第二个打开了 1 个工作簿,这将列出 3 个窗口,[我认为]无法区分哪个在哪个实例中。跨度> @ashleedawg,这个例子列出了所有窗口的所有实例。如果一个实例有多个窗口,您最终会得到重复的实例。如果您想列出所有打开的工作簿,请阅读acc.Parent
(Dim wb As WorkBook
Set wb = acc.Parent
)。
我发现(至少对我而言)如果实例没有打开的工作簿,函数将不包含 Excel 应用程序对象(注意:隐藏的个人工作簿也算作打开的工作簿,同样如此任何打开的 XLA 插件,因此需要关闭测试才能测试)。如果实例没有打开的工作簿,则如果比较返回 False,则似乎如下: AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 任何人都可以帮助进行包含这些的更正吗?【参考方案2】:
这最好作为对 Florent B. 非常有用的函数的评论,该函数返回打开的 Excel 实例的集合,但我没有足够的声誉来添加 cmets。在我的测试中,该集合包含相同 Excel 实例的“重复”,即 GetExcelInstances().Count
比应有的大。解决此问题的方法是在以下版本中使用 AlreadyThere
变量。
Private Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Dim AlreadyThere As Boolean
Dim xl As Application
Set GetExcelInstances = 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), acc) = 0 Then
AlreadyThere = False
For Each xl In GetExcelInstances
If xl Is acc.Application Then
AlreadyThere = True
Exit For
End If
Next
If Not AlreadyThere Then
GetExcelInstances.Add acc.Application
End If
End If
Loop
End Function
【讨论】:
很酷的答案,但这并没有列出所有打开的实例。例如,我测试了两个打开的实例,一个有 1 个工作簿,一个有 2 个工作簿,您的修改只列出了 2 个工作簿。我认为它没有列出未保存的工作簿(就像原始答案一样 - 但它也没有区分实例) 我们不要将 Application 对象与 Workbook 对象混淆。根据原始问题,我的 FlorentB 函数版本返回 Application 对象的集合。因此,如果有两个 Excel 实例正在运行(第二个在按住 ALT 键的情况下启动),则该函数将返回一个双元素集合。每个应用程序的工作簿集合中的工作簿数量不相关。当然,可以编写一个嵌套循环来循环每个应用程序对象的工作簿集合。 这太棒了,完全符合它的要求。不知道为什么其他人反对它。可能没看懂! 我发现(至少对我而言)如果实例没有打开的工作簿,函数将不包含 Excel 应用程序对象(注意:隐藏的个人工作簿也算作打开的工作簿,同样如此任何打开的 XLA 插件,因此需要关闭测试才能测试)。如果实例没有打开的工作簿,则如果比较返回 False,则似乎如下: AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 任何人都可以帮助进行包含这些的更正吗?【参考方案3】:@PGS62/@Philip Swannell 有返回 Collection 的正确答案;我可以迭代所有实例;正如@M1chael 评论的那样,它很棒。
我们不要将 Application 对象与 Workbook 对象混淆... ...的 当然可以编写一个嵌套循环来循环 每个应用程序对象的工作簿集合
这是实现且功能齐全的嵌套循环:
Sub Test2XL()
Dim xl As Excel.Application
Dim i As Integer
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.Application.hwnd
Debug.Print "# workbooks: " & xl.Application.Workbooks.Count
For i = 1 To xl.Application.Workbooks.Count
Debug.Print "Workbook: " & xl.Application.Workbooks(i).Name
Debug.Print "Workbook path: " & xl.Application.Workbooks(i).path
Next i
Next
Set xl = Nothing
End Sub
对于 Word 实例,嵌套循环:
Sub Test2Wd()
Dim wd As Word.Application
Dim i As Integer
For Each wd In GetWordInstancesCol()
Debug.Print "Version: " & wd.System.Version
Debug.Print "# Documents: " & wd.Application.Documents.Count
For i = 1 To wd.Application.Documents.Count
Debug.Print "Document: " & wd.Application.Documents(i).Name
Debug.Print "Document path: " & wd.Application.Documents(i).path
Next i
Next
Set wd = Nothing
End Sub
对于 Word,您必须使用 thread 末尾的说明
【讨论】:
【参考方案4】:我使用以下命令检查两个实例是否正在运行,并显示一条消息。可以更改它以关闭其他实例...这可能会有所帮助...我需要代码来返回特定实例,并返回类似于 GetObject(,"Excel.Application") 的使用...我不觉得有可能
If checkIfExcelRunningMoreThanOneInstance() Then Exit Function
在模块中(某些声明可能用于其他代码):
Const MaxNumberOfWindows = 10
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Global ret As Integer
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const VK_CAPITAL = &H14
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Global ExcelWindowName$ 'Used to switch back to later
Function checkIfExcelRunningMoreThanOneInstance()
'Check instance it is 1, else ask user to reboot excel, return TRUE to abort
ExcelWindowName = excel.Application.Caption 'Used to switch back to window later
If countProcessRunning("excel.exe") > 1 Then
Dim t$
t = "Two copies of 'Excel.exe' are running, which may stop in cell searching from working!" & vbCrLf & vbCrLf & "Please close all copies of Excel." & vbCrLf & _
" (1 Then press Alt+Ctrl+Del to go to task manager." & vbCrLf & _
" (2 Search the processes running to find 'Excel.exe'" & vbCrLf & _
" (3 Select it and press [End Task] button." & vbCrLf & _
" (4 Then reopen and use PostTrans"
MsgBox t, vbCritical, ApplicationName
End If
End Function
Private Function countProcessRunning(ByVal sProcess As String) As Long
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
Dim sName As String
countProcessRunning = 0
sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then
countProcessRunning = countProcessRunning + 1
End If
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function
我找到的:
Dim xlApp As Excel.Application
Set xlApp = GetObject("ExampleBook.xlsx").Application
如果您知道 Excel 实例中当前活动的工作表的名称,它将获取对象。我想这可以使用第一段代码从应用程序标题中获得。在我的应用中,我确实知道文件名。
【讨论】:
【参考方案5】:您应该在每次需要 Excel 应用程序对象时使用此代码。这样,您的代码将只能使用一个应用程序对象或使用一个预先存在的应用程序对象。最终获得多个的唯一方法是用户启动多个。这既是打开 Excel 的代码,又是您想要的附加和重用代码。
Public Function GetExcelApplication() As Object
On Error GoTo openExcel
Set GetExcelApplication = GetObject(, "Excel.Application")
Exit Function
openExcel:
If Err.Number = 429 Then
Set GetExcelApplication = CreateObject("Excel.Application")
Else
Debug.Print "Unhandled exception: " & Err.Number & " " & Err.Description
End If
End Function
如果你想关闭多个实例,你需要在循环中调用GetObject
,然后是.Close
,直到它抛出错误429。
详情可在此Article
【讨论】:
【参考方案6】:这可以完成你想要的。 确定 Excel 实例是否打开:
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
如果一个实例正在运行,您可以使用xlApp
对象访问它。如果实例未运行,您将收到运行时错误(您可能需要/想要错误处理程序)。 GetObject
函数获取已加载的第一个 Excel 实例。你可以用它来完成你的工作,要找到其他人,你可以关闭那个,然后再次尝试GetObject
以获得下一个,等等。
所以你将实现你的好但次要的目标
(取自http://excelribbon.tips.net/T009452_Finding_Other_Instances_of_Excel_in_a_Macro.html)。
为了实现您的首选目标,我认为https://***.com/a/3303016/2707864 向您展示了如何实现。
【讨论】:
【参考方案7】:创建一个对象数组并将新创建的 Excel.Application 存储在该数组中。这样您就可以在需要时引用它们。让我们举个简单的例子:
在一个模块中:
Dim ExcelApp(2) As Object
Sub Test()
Set ExcelApp(1) = CreateObject("Excel.Application")
ExcelApp(1).Visible = True
Set ExcelApp(2) = CreateObject("Excel.Application")
ExcelApp(2).Visible = True
End Sub
Sub AnotherTest()
ExcelApp(1).Quit
ExcelApp(2).Quit
End Sub
运行 Test() 宏,您应该会看到两个 Excel 应用程序弹出。然后运行 AnotherTest(),Excel 应用程序将退出。完成后,您甚至可以将数组设置为 Nothing。
您可以使用http://www.ozgrid.com/forum/showthread.php?t=182853 上发布的脚本来处理正在运行的 Excel 应用程序。这应该可以带你去你想去的地方。
【讨论】:
虽然我确实将它们存储在变量中。但有时我需要更改 VBA 程序的其他部分。 VBA 项目有时会被重置,所有变量都会丢失。但启动的 Excel 实例仍在后台运行。 这很棘手。 GetObject 和查找窗口句柄是几个选项。 sancho.s 在该答案中有一些您可以使用的链接。以上是关于启动了多个 Excel 实例后,如何获取所有这些实例的应用程序对象?的主要内容,如果未能解决你的问题,请参考以下文章