从 MS Access 打开时，VBA Excel 实例不会关闭 - 后期绑定

Question

我知道这已经被散列了很多次，但没有一个解决方案适合我

这从 MS Access 运行

Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Workbooks.Open CurPath & MainProjectName & ".xlsm", True
ExcelApp.Visible = False
ExcelApp.Quit
Set ExcelApp = Nothing

此外，.xlsm 文件在过程结束时执行以下操作

    ActiveWorkbook.Save
    ActiveWorkbook.Close

End Sub

但 .xlsm 文件仍处于隐藏状态。我将其视为一个实例，而不是应用程序，并且我知道 .xlsm 文件保持打开状态的原因是有时 excel VBA 窗口保持打开状态（只是 VBA 窗口，而不是 Excel 窗口），在那里我可以看到哪个文件模块在那里。

发布我所有的代码

这是从 MS Access 运行并打开 xlsm 文件的部分

Public Function RunLoadFilesTest()

    ODBCConnString
    RunVariables

    Dim Rs2   As DAO.Recordset
    Dim TABLENAME As String

    Set Rs2 = CurrentDb.OpenRecordset("SELECT * FROM QFilesToExportEMail")

    Do Until Rs2.EOF
        TABLENAME = Rs2("TableName")
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, TABLENAME, CurPath & MainProjectName & ".xlsm", True
        Rs2.MoveNext
    Loop

    Rs2.Close
    Set Rs2 = Nothing

Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWbk = ExcelApp.Workbooks.Open(CurPath & MainProjectName & ".xlsm", True)
ExcelApp.Visible = False     ' APP RUNS IN BACKGROUND
'ExcelWbk.Close      ' POSSIBLY SKIP IF WORKBOOK IS CLOSED
ExcelApp.Quit

' RELEASE RESOURCES
Set ExcelWbk = Nothing
Set ExcelApp = Nothing
    
End Function

这是 xlsm 文件的代码。它会从 ThisWorkbook 模块自动打开。我删除了很多代码以免使线程混乱，但留下了打开工作簿、激活工作簿、关闭等的每一部分。

Public Sub MainProcedure()

    Application.EnableCancelKey = xlDisabled
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    CurPath = ActiveWorkbook.Path & "\"

    'this is to deselect sheets
    Sheets("QFilesToExportEMail").Select

    Sheets("QReportDates").Activate

    FormattedDate = Range("A2").Value
    RunDate = Range("B2").Value
    ReportPath = Range("C2").Value
    MonthlyPath = Range("D2").Value
    ProjectName = Range("E2").Value
         
    Windows(ProjectName & ".xlsm").Activate
    Sheets("QFilesToExportEMail").Select
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    

    Dim i     As Integer

    CurRowNum = 2

    Set CurRange = Sheets("QFilesToExportEMail").Range("B" & CurRowNum & ":B" & LastRow)

    For Each CurCell In CurRange
                     
        If CurCell <> "" Then
                                   
            Windows(ProjectName & ".xlsm").Activate
            Sheets("QFilesToExportEMail").Select
            FirstRowOfSection = ActiveWorkbook.Worksheets("QFilesToExportEMail").Columns(2).Find(ExcelFileName).Row
                                                        
            If ExcelSheetName = "" Then
                ExcelSheetName = TableName
            End If
                                                        
            If CurRowNum = FirstRowOfSection Then
                SheetToSelect = ExcelSheetName
            End If
                                   
            If IsNull(TemplateFileName) Or TemplateFileName = "" Then
                Workbooks.Add
            Else
                Workbooks.Open CurPath & TemplateFileName
            End If
                                   
            ActiveWorkbook.SaveAs MonthlyPath & FinalExcelFileName
                                   
            For i = CurRowNum To LastRowOfSection
                Windows(ProjectName & ".xlsm").Activate
                Sheets("QFilesToExportEMail").Select
            Next i
        End If
                     
        Windows(FinalExcelFileName).Activate
        Sheets(SheetToSelect).Select
                                   
        ActiveWorkbook.Save
        ActiveWorkbook.Close
                     
        If LastRowOfSection >= LastRow Then
            Exit For
        End If
                     
    Next

    Set CurRange = Sheets("QFilesToExportEMail").Range("A2:A" & LastRow)
    For Each CurCell In CurRange
        If CurCell <> "" Then

            CurSheetName = CurCell

            If CheckSheet(CurSheetName) Then
                Sheets(CurSheetName).Delete
            End If

        End If
    Next
   
    Sheets("QFilesToExportEMail").Delete
    Sheets("QReportDates").Delete
                                             
    ActiveWorkbook.Save
    ActiveWorkbook.Close

End Sub

Answer 1

底层过程仍然存在，因为工作簿对象没有像您对应用程序对象那样完全释放。但是，这需要您分配工作簿对象以便稍后发布。

Dim ExcelApp As object, ExcelWbk as Object

Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWbk = ExcelApp.Workbooks.Open(CurPath & MainProjectName & ".xlsm", True)
ExcelApp.Visible = False     ' APP RUNS IN BACKGROUND


'... DO STUFF

' CLOSE OBJECTS
ExcelWbk.Close
ExcelApp.Quit

' RELEASE RESOURCES
Set ExcelWbk = Nothing
Set ExcelApp = Nothing

这适用于任何与 COM 连接的语言，例如 VBA，包括：

• Python：WIN32COM saving/exporting multiple sheets as PDF;
• R：How to export an Excel sheet range to a picture, from within R，和
• PHP：Converting excel to pdf using PHP

如图所示，即使是开源也可以像 VBA 一样从外部连接到 Excel，并且应该始终以相应的语义释放已初始化的对象。

---

考虑重构 Excel VBA 代码以获得最佳实践：

• 显式声明变量和类型；
• 集成适当的错误处理（否则会使资源保持运行）；
• 使用With...End With 块并避免Activate、Select、ActiveWorkbook 和ActiveSheet（这会导致运行时错误）；
• 声明并使用Cell、Range或Workbook对象，最后取消初始化所有Set对象；
• 在需要的地方使用ThisWorkbook. 限定符（即代码所在的工作簿）。

注意：以下内容未经测试。如此仔细地测试、调试，尤其是由于使用了所有名称。

Option Explicit       ' BEST PRACTICE TO INCLUDE AS TOP LINE AND 
                      ' AND ALWAYS Debug\Compile AFTER CODE CHANGES

Public Sub MainProcedure()
On Error GoTo ErrHandle
    ' EXPLICITLY DECLARE EVERY VARIABLE AND TYPE
    Dim FormattedDate As Date, RunDate As Date

    Dim ReportPath As String, MonthlyPath As String, CurPath As String
    Dim ProjectName As String, ExcelFileName As String, FinalExcelFileName As String
    Dim TableName As String, TemplateFileName As String
    Dim SheetToSelect As String, ExcelSheetName As String
    Dim CurSheetName As String
    
    Dim i As Integer, CurRowNum As Long, LastRow As Long
    Dim FirstRowOfSection As Long, LastRowOfSection As Long
    Dim CurCell As Variant, curRange As Range
    
    Dim wb As Workbook
        
    Application.EnableCancelKey = xlDisabled
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    CurPath = ThisWorkbook.Path & "\"                     ' USE ThisWorkbook

    With ThisWorkbook.Worksheets("QReportDates")          ' USE WITH CONTEXT
        FormattedDate = .Range("A2").Value
        RunDate = .Range("B2").Value
        ReportPath = .Range("C2").Value
        MonthlyPath = .Range("D2").Value
        ProjectName = .Range("E2").Value
    End With
    
    CurRowNum = 2
    With ThisWorkbook.Worksheets("QFilesToExportEMail")   ' USE WITH CONTEXT
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
        Set curRange = .Range("B" & CurRowNum & ":B" & LastRow)

        For Each CurCell In curRange
            If CurCell <> "" Then
                FirstRowOfSection = .Columns(2).Find(ExcelFileName).Row
                                                            
                If ExcelSheetName = "" Then
                    ExcelSheetName = TableName
                End If
                                                            
                If CurRowNum = FirstRowOfSection Then
                    SheetToSelect = ExcelSheetName
                End If
                                       
                ' USE WORKBOOK OBJECT
                If IsNull(TemplateFileName) Or TemplateFileName = "" Then
                    Set wb = Workbooks.Add
                Else
                    Set wb = Workbooks.Open(CurPath & TemplateFileName)
                End If
                                       
                wb.SaveAs MonthlyPath & FinalExcelFileName
            End If
                         
            ' USE WORKBOOK OBJECT
            wb.Worksheets(SheetToSelect).Select
            wb.Save
            wb.Close
            Set wb = Nothing                              ' RELEASE RESOURCE
            
            If LastRowOfSection >= LastRow Then
                Exit For
            End If
        Next CurCell

        Set curRange = .Range("A2:A" & LastRow)
        For Each CurCell In curRange
            If CurCell <> "" Then
                CurSheetName = CurCell
    
                If CheckSheet(CurSheetName) Then         ' ASSUMED A SEPARATE FUNCTION
                    ThisWorkbook.Worksheets(CurSheetName).Delete
                End If
    
            End If
        Next CurCell
    End With
    
    ' USE ThisWorkbook QUALIFIER
    ThisWorkbook.Worksheets("QFilesToExportEMail").Delete
    ThisWorkbook.Worksheets("QReportDates").Delete
    ThisWorkbook.Save
    ' ThisWorkbook.Close                                 ' AVOID CLOSING IN MACRO

ExitHandle:
    ' ALWAYS RELEASE RESOURCE (ERROR OR NOT)
    Set curCell = Nothing: Set curRange = Nothing: Set wb = Nothing
    Exit Sub
    
ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle
End Sub