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

时间：2015-05-21 02:53:01

标签： excel vba

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

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

我想重新连接到重复使用（首选方式）或关闭它们。

7 个答案:

答案 0 :(得分：12)

列出正在运行的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

答案 1 :(得分：3)

最好将其作为对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

答案 2 :(得分：1)

@ PGS62具有返回集合的正确答案；我可以迭代所有实例；就像@ 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

结尾中说明的内容

答案 3 :(得分：0)

创建一个对象数组，并将新创建的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应用程序的过程。这应该可以让你到达目的地。

答案 4 :(得分：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实例中当前活动的工作表的名称，则会获取该对象。我想这可以使用第一部分代码从应用程序标题中获得。在我的应用中，我确实知道文件名。

答案 5 :(得分：0)

每次需要 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 :(得分：-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://stackoverflow.com/a/3303016/2707864会向您展示如何。

相关问题
最新问题