从 MS Access 打开时,VBA Excel 实例不会关闭 - 后期绑定 [英] VBA Excel instance doesn't close when opened from MS Access - late binding

查看:37
本文介绍了从 MS Access 打开时,VBA Excel 实例不会关闭 - 后期绑定的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

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

I know that this has been hashed over many times but none of the solutions work for me

这从 MS Access 运行

This runs from MS Access

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

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

Also, the .xlsm file does the following at the end of the procedure

    ActiveWorkbook.Save
    ActiveWorkbook.Close

End Sub

但 .xlsm 文件仍然隐藏在某处打开.我将它视为一个实例,而不是一个应用程序,我知道 .xlsm 文件保持打开状态的原因是有时 excel VBA 窗口保持打开状态(只是 VBA 窗口,而不是 Excel 窗口),在那里我可以看到哪个文件是模块在那里.

but the .xlsm file remains open hidden somewhere. i see it as an instance, not as an application and the reason i know that the .xlsm file stays open because sometimes the excel VBA window stays open (just the VBA window, not the Excel window) and in there i can see which file's modules are there.

发布我所有的代码

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

this is the piece that runs from MS Access and opens the xlsm file

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 模块自动打开.我删除了很多代码,以免使线程混乱,但留下了打开工作簿、激活工作簿、关闭等的每一部分.

this is the code of the xlsm file. it opens automatically from the ThisWorkbook module. i removed a lot of the code not to clutter the thread but left every piece that opens a workbook, activates a workbook, closes, etc.

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

推荐答案

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

The underlying process remains since the workbook object was not fully released like you did with the app object. However, this requires you to assign the workbook object in order to release later.

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,包括:

This is true for any COM-connected language like VBA, including:

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

As shown, even open source can connect to Excel externally like VBA and should always release initialized objects in their corresponding semantics.

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

Consider refactoring of Excel VBA code to for best practices:

  • 显式声明变量和类型;
  • 集成适当的错误处理(没有可以让资源运行);
  • 使用 With...End With 块并避免 ActivateSelectActiveWorkbook>ActiveSheet(可能导致运行时错误);
  • 声明并使用CellRangeWorkbook对象,并在最后取消初始化所有Set对象;
  • 在需要的地方使用 ThisWorkbook. 限定符(即代码所在的工作簿).
  • Explicitly declare variables and types;
  • Integrate proper error handling (that without can leave resources running);
  • Use With...End With blocks and avoid Activate, Select, ActiveWorkbook, and ActiveSheet (that can cause runtime errors);
  • Declare and use Cell, Range, or Workbook objects and at end uninitialize all Set objects;
  • Use ThisWorkbook. qualifier where needed (i.e., workbook where code resides).

注意:以下未经测试.所以仔细测试,调试,特别是因为所有的名字都被使用了.

NOTE: Below is untested. So carefully test, debug especially due to all the names being used.

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

这篇关于从 MS Access 打开时,VBA Excel 实例不会关闭 - 后期绑定的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆