logo标签列表

启动了多个Excel实例，如何获取每个实例的应用程序对象？

excelvba
16

我希望使用类似于GetObject(,"Excel.Application")的方法来获取我创建的应用程序。

我调用 CreateObject("Excel.Application") 来创建 Excel 实例。稍后如果 VBA 项目重置，由于调试和编码，Application 对象变量会丢失，但 Excel 实例仍在后台运行。有点像内存泄漏的情况。

我想重新连接到这些实例以便重新使用（首选方式）或关闭它们。

最好是从一开始就避免这个问题。请参阅http://www.tushar-mehta.com/excel/vba/xl_doesnt_quit/index.htm。 - brettdj
你有发现任何有用的帖子吗？请根据你的发现发布反馈、投票和/或接受。 - sancho.s ReinstateMonicaCellio
1
以下4个答案都没有正确回答问题。最接近的是Florent的答案，它列出了工作簿（即使在多个实例中），但没有确定是否实际上有多个正在运行的实例，也不允许用户获取每个实例的Application对象（至少就我所知）。我还没有找到一种实际列出实例数量的方法。澄清一下，一个实例不仅仅是“另一个工作簿”；它实际上在内存的不同部分运行进程等等…… - ashleedawg
例如，可以通过在打开工作簿时按住ALT键或通过命令行启动Excel的方式来打开Excel的新实例，或者可以通过Microsoft的注册表调整来强制所有工作簿都在新实例中打开。 - ashleedawg
如果我理解正确，xl.ActiveWorkbook.Application 可以使用，另一个选项是 Florent B. 代码返回的完整路径文件字符串，可以使用 GetObject 函数访问应用程序，如此处所建议的 https://stackoverflow.com/a/46141767/6406135。 - robertocm
8个回答
28

列出正在运行的 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
2
有用的东西，谢谢 :) 应该被 PO 接受。 - Shai Rado
2
非常酷 +1 但是需要澄清的是，这不是列出 Excel 的 实例 - 而是列出 Excel 的 窗口。例如，如果我有两个 Excel 实例，第一个打开了2个工作簿，第二个打开了1个工作簿，这将列出3个窗口，[我认为]没有办法区分哪些属于哪个实例。 - ashleedawg
@ashleedawg，这个例子列出了所有窗口的所有实例。如果一个实例有多个窗口，则会出现重复的实例。如果您希望列出所有打开的工作簿，请阅读acc.Parent（Dim wb As WorkBook Set wb = acc.Parent）。 - Florent B.
1
我发现（至少对我来说），如果实例没有打开的工作簿，Function将不包括Excel Application对象（注意：隐藏的个人工作簿算作打开的工作簿，任何打开的XLA加载项也是如此，因此需要关闭测试以进行测试）。如果实例没有打开的工作簿，则似乎此If比较返回False：AccessibleObjectFromWindow（hwnd3，＆HFFFFFFF0，guid（0），acc）= 0。有人能帮忙纠正一下，使其包括这些内容吗？ - M1chael
10

最好将此作为对Florent B.非常有用的函数的评论，该函数返回打开的Excel实例的集合，但我没有足够的声望来添加评论。在我的测试中，该集合包含相同的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个工作簿。我认为它没有列出未保存的工作簿（就像原始答案一样 - 但它也没有区分实例）。 - ashleedawg
1
不要混淆应用程序对象和工作簿对象。根据原始问题，我的FlorentB函数版本返回一个应用程序对象集合。因此，如果有两个Excel实例正在运行（第二个使用ALT键启动），则该函数将返回一个包含两个元素的集合。每个应用程序的工作簿集合中的工作簿数量并不重要。当然，可以编写嵌套循环，循环遍历每个应用程序对象的工作簿集合。 - Philip Swannell
1
这太棒了，完全做到了它应该做的事情。不知道为什么有人给它点了踩。可能是因为他们不理解！ - M1chael
我发现（至少对我来说），如果实例没有打开的工作簿，Function 将不会包括 Excel 应用程序对象（注意：隐藏的个人工作簿算作已打开的工作簿，任何打开的 XLA 加载项也是如此，因此需要关闭测试以进行测试）。如果实例没有打开的工作簿，则似乎该 If 比较返回 False：AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0。有人能帮忙纠正一下，让其包含这些内容吗？ - M1chael
1

@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结尾处所解释的内容。

0

我总是将使用API函数作为最后的手段。我已经设计了一种方法，只要格式与此示例类似，它就能运行。这是完整的解决方案，不使用API命令：

实际上，这非常简单。在每个应用程序实例中预期加载的任何一个工作簿中，您必须存储一个公共子程序，它将用于一个非常基本的目的。

每个子程序都将作为整体编程链中的一个链接存在。每个“链接”将把当前应用程序的实例添加到一个在子程序之间传递的集合对象中，直到“链”完成。

步骤1： 以编程方式创建一个新的Excel实例。

步骤2： 为该新应用程序分配一个工作簿变量，指向打开方法。

步骤3： WBVariable.Application.Run "Subroutine", apps

如第3步所示，在单独的应用程序实例中加载的工作簿会将apps集合作为一个变量传递。一旦“接收器”子程序接收到该集合对象，该子程序就可以将当前应用程序对象添加到集合中。在每个预定的“链接”中重复执行步骤2和步骤3，直到停止在其最终目标处。

最终的实例理论上甚至可以被发送到原始工作簿中的一个“捕获器”子程序，或者通过可选参数递归地将最终的集合对象发送回源子程序，在这一点上，检查可能允许子程序现在继续超过先前的点。
听起来可能有些复杂，但只要稍加巧妙，就可以非常容易地实现这一点，而无需使用API调用。
0
我使用以下代码来检查两个实例是否正在运行，并显示一条消息。它可以被修改以关闭其他实例...这可能会有所帮助...我需要代码来返回特定的实例，并返回类似于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实例中处于活动状态的工作表的名称，则可以使用此方法获取该对象。我猜这可以通过使用第一段代码从应用程序标题中获取。在我的应用程序中，我知道文件名。

-1
创建一个对象数组并将新创建的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实例仍在后台运行。 - NathaneilCapital
这有点棘手。GetObject和查找窗口句柄是几个选项。sancho.s在那个答案中提供了一些链接，你可以使用。 - zedfoxus
-1

这可以实现你想要的功能。 确定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://dev59.com/jnA85IYBdhLWcg3wCe9Z#3303016向您展示了如何做到这一点。
-1
每次需要 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。

详细信息可以在这篇文章中找到。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接