【发布时间】：2021-11-27 18:05:42
【问题描述】：
我一直致力于在 Excel 中使用 VBA 从第 3 方应用程序（在本例中为 Qlikview）导出数据，并自动执行查找导出数据并将值从那里复制到目标工作簿的过程。我可以做到这一切，但有时导出会在新的 Excel 实例中打开，我需要找到它。我调整了here 的答案以找到我需要的内容，但是当我使用该解决方案找到导出的工作簿时，我发现与导出的工作簿关联的 VBA 项目在工作簿关闭后仍然存在。完整的代码会打开和关闭其中的很多，这会导致性能问题；似乎这些项目仍在记忆中。
我发现了类似的问题，大多数答案都建议将对象引用设置为 Nothing 将解决该问题，但在这种情况下没有帮助。我怀疑它与我正在调用的 dll 函数有关。这是我正在使用的能够重现该问题的代码：
Sub getQlikDataToExcel()
Dim qlikTableName As String
Dim qD As QlikView.Document
Dim qApp As New QlikView.Application 'connects to running QlikView app
Dim srcWb As Workbook
Set qD = qApp.ActiveDocument 'use for testing purposes
qlikTableName = "Document\CH78" 'name of table in Qlik app
Set srcWb = tableToExcel(qlikTableName, qD)
srcWb.Close False
Set srcWb = Nothing
End Sub
Function tableToExcel(tName As String, qD As QlikView.Document, Optional waitIntervalSecs As Long = 180) As Workbook
Dim success As Boolean, wbNew As Boolean
Dim timeout As Date
Dim openWbs As New Collection
Dim wb As Workbook, openWb As Workbook
Dim xlApp As Application
' create a collection of open workbooks
' will check for multiple Excel instances
For Each xlApp In xlInst.GetExcelInstances()
For Each wb In xlApp.Workbooks
openWbs.Add wb
Next wb
Next xlApp
wbNew = False
success = False
timeout = DateAdd("s", waitIntervalSecs, Now())
DoEvents
qD.GetSheetObject(tName).SendToExcel
' loop through all workbooks until the new book created by qlik is generated
Do
DoEvents
For Each xlApp In xlInst.GetExcelInstances()
For Each wb In xlApp.Workbooks
' check if workbook name contains the table name from qlik
If InStr(1, wb.Name, tName) > 0 Or _
InStr(1, wb.Name, Replace(tName, "Document\", "")) > 0 Or _
InStr(1, wb.Name, Replace(tName, "Server\", "")) > 0 Then
' set flag to new
wbNew = True
' if workbook already existed flag it as not new
For Each openWb In openWbs
If wb Is openWb Then wbNew = False
Next openWb
' if new workbook, function returns workbook
If wbNew Then
Set tableToExcel = wb
success = True
End If
End If
Next wb
Next xlApp
' loop terminates when workbook is found or after a timeout
Loop Until success Or Now() > timeout
Set wb = Nothing
Set xlApp = Nothing
' function returns Nothing if timeout
If Not success Then Set tableToExcel = Nothing
End Function
xlInst 模块中的代码如下：
#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
' Source:
' https://stackoverflow.com/questions/30363748/having-multiple-excel-instances-launched-how-can-i-get-the-application-object-f
'
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
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
Set xl = Nothing
Set acc = Nothing
End Function
请注意，如果我坚持使用当前的 Excel 实例，我不会遇到问题； IE。我修改了代码，使其不使用xlInst 模块。除非 3rd 方应用程序决定导出到新实例，否则这工作正常；不知道我是否可以强制这样做。
--编辑--
如果不清楚，我可以运行程序并避免使用xlInst 模块，如果我删除了For Each xlApp In xlInst.GetExcelInstances() 行并将xlApp 设置为当前实例。当我这样做时，VB 项目在我运行时不会持续存在。
【问题讨论】：
标签： excel vba dll qlikview user32