启动了多个excel实例后,如何获取所有这些实例的应用程序对象？

Question

基本上,我想使用类似的东西 GetObject(,"Excel.Application")来取回我创建的应用程序.

我打了几次电话CreateObject("Excel.Application")来创建新的excel实例.后来由于调试和编码,VBA项目被重置.Application对象变量丢失了.但是excel仍然在后台运行.有种内存泄漏的情况.

我只想重新加入他们.重复使用(首选这种方式)或关闭它们.

Answer 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

Answer 2

这将是对 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

Answer 3

创建一个对象数组并将新创建的 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 应用程序。这应该能带你去你想去的地方。