Reputation: 413
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
Upvotes: 1
Views: 612
Reputation: 107767
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:
With...End With
blocks and avoid Activate
, Select
, ActiveWorkbook
, and ActiveSheet
(that can cause runtime errors);Cell
, Range
, or Workbook
objects and at end uninitialize all Set
objects;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
Upvotes: 2