简体   繁体   中英

VBA Excel instance doesn't close when opened from MS Access - late binding

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

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

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

    ActiveWorkbook.Save
    ActiveWorkbook.Close

End Sub

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.

posting all my code

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

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

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

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


Consider refactoring of Excel VBA code to for best practices:

  • 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 (ie, 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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM