启动多个Excel示例后,如何获取所有示例的应用程序对象?

rhfm7lfc  于 2023-08-08  发布在  其他
关注(0)|答案(8)|浏览(183)

我想使用类似于GetObject(,"Excel.Application")的东西来取回我创建的应用程序。
我调用CreateObject("Excel.Application")来创建Excel示例。以后,如果VBA工程重置,由于调试和编码,Application对象变量将丢失,但Excel示例将在后台运行。有点内存泄漏的情况。
我想重新连接到重新使用(首选方式)或关闭它们。

nx7onnlm

nx7onnlm1#

要列出正在运行的Excel示例,请执行以下操作:

  1. #If VBA7 Then
  2. Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
  3. ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
  4. Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
  5. ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
  6. ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
  7. #Else
  8. Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
  9. ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
  10. Private Declare Function FindWindowExA Lib "user32" ( _
  11. ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
  12. ByVal lpszClass As String, ByVal lpszWindow As String) As Long
  13. #End If
  14. Sub Test()
  15. Dim xl As Application
  16. For Each xl In GetExcelInstances()
  17. Debug.Print "Handle: " & xl.ActiveWorkbook.FullName
  18. Next
  19. End Sub
  20. Public Function GetExcelInstances() As Collection
  21. Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
  22. guid(0) = &H20400
  23. guid(1) = &H0
  24. guid(2) = &HC0
  25. guid(3) = &H46000000
  26. Set GetExcelInstances = New Collection
  27. Do
  28. hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
  29. If hwnd = 0 Then Exit Do
  30. hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
  31. hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
  32. If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
  33. GetExcelInstances.Add acc.Application
  34. End If
  35. Loop
  36. End Function

字符串

展开查看全部
wh6knrhe

wh6knrhe2#

这是对Florent B.非常有用的函数的最佳评论,该函数返回打开的Excel示例的集合,但我没有足够的信誉来添加评论。在我的测试中,集合包含相同Excel示例的“重复”,即GetExcelInstances().Count比它应该的要大。在下面的版本中使用了AlreadyThere变量来修复此问题。

  1. Private Function GetExcelInstances() As Collection
  2. Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
  3. guid(0) = &H20400
  4. guid(1) = &H0
  5. guid(2) = &HC0
  6. guid(3) = &H46000000
  7. Dim AlreadyThere As Boolean
  8. Dim xl As Application
  9. Set GetExcelInstances = New Collection
  10. Do
  11. hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
  12. If hwnd = 0 Then Exit Do
  13. hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
  14. hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
  15. If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
  16. AlreadyThere = False
  17. For Each xl In GetExcelInstances
  18. If xl Is acc.Application Then
  19. AlreadyThere = True
  20. Exit For
  21. End If
  22. Next
  23. If Not AlreadyThere Then
  24. GetExcelInstances.Add acc.Application
  25. End If
  26. End If
  27. Loop
  28. End Function

字符串

展开查看全部
shstlldc

shstlldc3#

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

  1. Sub Test2XL()
  2. Dim xl As Excel.Application
  3. Dim i As Integer
  4. For Each xl In GetExcelInstances()
  5. Debug.Print "Handle: " & xl.Application.hwnd
  6. Debug.Print "# workbooks: " & xl.Application.Workbooks.Count
  7. For i = 1 To xl.Application.Workbooks.Count
  8. Debug.Print "Workbook: " & xl.Application.Workbooks(i).Name
  9. Debug.Print "Workbook path: " & xl.Application.Workbooks(i).path
  10. Next i
  11. Next
  12. Set xl = Nothing
  13. End Sub

字符串
对于Word示例,嵌套循环:

  1. Sub Test2Wd()
  2. Dim wd As Word.Application
  3. Dim i As Integer
  4. For Each wd In GetWordInstancesCol()
  5. Debug.Print "Version: " & wd.System.Version
  6. Debug.Print "# Documents: " & wd.Application.Documents.Count
  7. For i = 1 To wd.Application.Documents.Count
  8. Debug.Print "Document: " & wd.Application.Documents(i).Name
  9. Debug.Print "Document path: " & wd.Application.Documents(i).path
  10. Next i
  11. Next
  12. Set wd = Nothing
  13. End Sub


对于Word,您必须使用本thread结尾处解释的内容

展开查看全部
huus2vyu

huus2vyu4#

我使用下面的代码来检查是否有两个示例正在运行,并显示一条消息。它可以被修改为关闭其他示例...这可能会有帮助。。我需要代码来返回一个特定的示例,并返回类似于GetObject(,“Excel.Application”)的使用...但我觉得不可能

  1. If checkIfExcelRunningMoreThanOneInstance() Then Exit Function

字符串
在模块中(一些声明可能用于其他代码):

  1. Const MaxNumberOfWindows = 10
  2. Const HWND_TOPMOST = -1
  3. Const SWP_NOSIZE = &H1
  4. Const SWP_NOMOVE = &H2
  5. Type RECT
  6. Left As Long
  7. Top As Long
  8. Right As Long
  9. Bottom As Long
  10. End Type
  11. Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  12. Global ret As Integer
  13. Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  14. 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
  15. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  16. Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
  17. Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
  18. Declare Function GetDesktopWindow Lib "user32" () As Long
  19. Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  20. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  21. Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  22. Private Declare Function FindWindow Lib "user32" _
  23. Alias "FindWindowA" _
  24. (ByVal lpClassName As String, _
  25. ByVal lpWindowName As String) As Long
  26. Private Const VK_CAPITAL = &H14
  27. Private Declare Function GetKeyState Lib "user32" _
  28. (ByVal nVirtKey As Long) As Integer
  29. Private Declare Function OpenProcess Lib "kernel32" ( _
  30. ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  31. Private Declare Function CloseHandle Lib "kernel32" ( _
  32. ByVal hObject As Long) As Long
  33. Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
  34. lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
  35. Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
  36. ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
  37. Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
  38. ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
  39. Private Const PROCESS_VM_READ = &H10
  40. Private Const PROCESS_QUERY_INFORMATION = &H400
  41. Global ExcelWindowName$ 'Used to switch back to later
  42. Function checkIfExcelRunningMoreThanOneInstance()
  43. 'Check instance it is 1, else ask user to reboot excel, return TRUE to abort
  44. ExcelWindowName = excel.Application.Caption 'Used to switch back to window later
  45. If countProcessRunning("excel.exe") > 1 Then
  46. Dim t$
  47. 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 & _
  48. " (1 Then press Alt+Ctrl+Del to go to task manager." & vbCrLf & _
  49. " (2 Search the processes running to find 'Excel.exe'" & vbCrLf & _
  50. " (3 Select it and press [End Task] button." & vbCrLf & _
  51. " (4 Then reopen and use PostTrans"
  52. MsgBox t, vbCritical, ApplicationName
  53. End If
  54. End Function
  55. Private Function countProcessRunning(ByVal sProcess As String) As Long
  56. Const MAX_PATH As Long = 260
  57. Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
  58. Dim sName As String
  59. countProcessRunning = 0
  60. sProcess = UCase$(sProcess)
  61. ReDim lProcesses(1023) As Long
  62. If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
  63. For N = 0 To (lRet \ 4) - 1
  64. hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
  65. If hProcess Then
  66. ReDim lModules(1023)
  67. If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
  68. sName = String$(MAX_PATH, vbNullChar)
  69. GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
  70. sName = Left$(sName, InStr(sName, vbNullChar) - 1)
  71. If Len(sName) = Len(sProcess) Then
  72. If sProcess = UCase$(sName) Then
  73. countProcessRunning = countProcessRunning + 1
  74. End If
  75. End If
  76. End If
  77. End If
  78. CloseHandle hProcess
  79. Next N
  80. End If
  81. End Function


我发现:

  1. Dim xlApp As Excel.Application
  2. Set xlApp = GetObject("ExampleBook.xlsx").Application


如果您知道Excel示例中当前活动的工作表的名称,则获取该对象。我猜这可以从应用程序标题中使用第一位代码获得。在我的应用程序中,我知道文件名。

展开查看全部
htrmnn0y

htrmnn0y5#

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

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

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

0x6upsns

0x6upsns6#

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

  1. Dim xlApp As Excel.Application
  2. 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向你展示了如何实现。

oknwwptz

oknwwptz7#

创建一个对象数组,并将新创建的Excel.application存储在该数组中。这样,您就可以在需要时引用它们。让我们举一个简单的例子:
在模块中:

  1. Dim ExcelApp(2) As Object
  2. Sub Test()
  3. Set ExcelApp(1) = CreateObject("Excel.Application")
  4. ExcelApp(1).Visible = True
  5. Set ExcelApp(2) = CreateObject("Excel.Application")
  6. ExcelApp(2).Visible = True
  7. End Sub
  8. Sub AnotherTest()
  9. ExcelApp(1).Quit
  10. ExcelApp(2).Quit
  11. End Sub

字符串
运行Test()宏,您应该会看到两个Excel应用程序弹出。然后运行AnotherTest(),Excel应用程序将退出。您甚至可以在完成后将数组设置为Nothing。
您可以使用在http://www.ozgrid.com/forum/showthread.php?t=182853上发布的脚本来运行Excel应用程序。那应该能把你带到你想去的地方。

展开查看全部
nue99wik

nue99wik8#

每次需要Excel应用程序对象时都应使用此代码。这样,您的代码将只能使用一个应用程序对象或使用预先存在的对象。如果用户启动了多个,那么您最终可能会拥有多个的唯一方法。这既是打开Excel的代码,也是附加和重用的代码,如您所愿。

  1. Public Function GetExcelApplication() As Object
  2. On Error GoTo openExcel
  3. Set GetExcelApplication = GetObject(, "Excel.Application")
  4. Exit Function
  5. openExcel:
  6. If Err.Number = 429 Then
  7. Set GetExcelApplication = CreateObject("Excel.Application")
  8. Else
  9. Debug.Print "Unhandled exception: " & Err.Number & " " & Err.Description
  10. End If
  11. End Function

字符串
如果你想关闭多个示例,你需要调用GetObject,然后在一个循环中调用.Close,直到它抛出错误429。
详细信息可以在此Article中找到

展开查看全部

相关问题