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

字符串

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

字符串

@PGS62/@Philip Swannell有返回集合的正确答案;我可以迭代所有示例;这是辉煌的，作为@M1chael评论.
我们不要把应用程序对象和工作簿对象搞混了…当然，也可以编写一个嵌套循环，在每个应用程序对象的workbooks集合上循环
这是实现的嵌套循环，功能齐全：

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

我使用下面的代码来检查是否有两个示例正在运行，并显示一条消息。它可以被修改为关闭其他示例...这可能会有帮助。。我需要代码来返回一个特定的示例，并返回类似于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示例中当前活动的工作表的名称，则获取该对象。我猜这可以从应用程序标题中使用第一位代码获得。在我的应用程序中，我知道文件名。

我总是喜欢把API函数作为最后的手段。我已经设计了一种方法，只要格式与此显示类似，该方法就可以工作。以下是不使用API命令的完整解决方案：
其实很简单。在每个应用程序示例中加载的任何一个工作簿中，必须存储一个公共子例程，它将用于非常基本的目的。
每个子例程将单独作为整个编程链中的一个链接存在。每个“链接”将把当前应用程序的示例添加到一个集合对象中，该集合对象在子例程之间传递，直到“链”完成。

**步骤1.**编程新建excel示例。
**步骤2.**为新应用的workbooks打开方法分配一个workbook变量。
**步骤3.**WBVariable.Application.运行“Subroutine”，apps

你可以在步骤3中看到。apps集合正作为变量传递到已在单独的应用程序示例中加载的工作簿。一旦“catcher”子例程接收到该集合对象，该子例程就可以将当前应用对象添加到该集合。步骤2和3可以在每个预定“链路”中重复，直到在其最终目的地停止。
理论上，最终示例甚至可以被发送到原始工作簿中的“捕捉器”子例程，或者可能通过可选参数递归地将最终集合对象发送到原始子例程中，此时检查可以允许子例程现在继续经过前一点。
这听起来可能很复杂，但只要有一点独创性，这是非常容易实现的 * 没有 * API调用。

这可以实现你想要的。确定Excel示例是否已打开：

Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")

字符串
如果一个示例正在运行，您可以使用xlApp对象访问它。如果一个示例没有运行，你会得到一个运行时错误（你可能需要一个错误处理程序）。GetObject函数获取已加载的Excel的第一个示例。您可以使用它来完成您的工作，并且要访问其他对象，您可以关闭该对象，然后再次尝试GetObject以获取下一个对象，等等。因此，你将达到你的OK，但第二首选的目标（取自http://excelribbon.tips.net/T009452_Finding_Other_Instances_of_Excel_in_a_Macro.html）。
为了达到你喜欢的目标，我认为https://stackoverflow.com/a/3303016/2707864向你展示了如何实现。

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

每次需要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中找到