I have VBA code in Access that processes some queries. A recordset is created from each query and then exported to Excel. After exporting, a FormatWorksheets sub is called to give some formatting to the excel file. Then, the recordset might also be exported to a specified worksheet in a generalized results file (created from an Excel template file). Again, once exported, FormatWorksheets is called for that specific sheet in the generalized results file.
I noticed that an instance of Excel was hanging around in the background processes section of my task manager after running my program. After some process of elimination I realized that if I comment out the call to FormatWorksheets that specifically formats the general results file, this doesn't happen (the specific line is highlighted below). Can anyone tell me why? Also, when I leave that line uncommented, one of the statements in my FormatWorksheets method will sometimes generate runtime error 462, but not always. If anyone knows what's causing that I'd love to hear it.
Option Compare Database
Option Explicit
Public Sub ExportData()
'object variables
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim objExcel As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim oFSO As Scripting.FileSystemObject
'variables for creating results files and folders
Dim strRootPath As String
Dim strFilepath As String
Dim strFilePathIncorrect As String
Dim strDirectory As String
Dim strFilename As String
Dim strFullFilepath As String
Dim strSummaryFilename As String
Dim strTemplateName As String
Dim strWorksheetName As String
Dim strQueryName As String
Dim strDate As String
Dim intYear As Integer
Dim strMonth As String
Dim intDay As Integer
Dim intCount As Integer
'boolean flags
Dim blnEXCEL As Boolean
Dim blnExportToResultsSummary As Boolean
blnEXCEL = False
Set db = CurrentDb
Set oFSO = CreateObject("Scripting.FileSystemObject")
intCount = 0
strDate = Format(Date, "mmddyy")
intYear = Year(Date)
strMonth = MonthName(Month(Date))
intDay = Day(Date)
strRootPath = "C:\Desktop\Practice Runs\"
'create folders for Excel files
strFilepath = strRootPath & "Results\"
If Dir(strFilepath, vbDirectory) = "" Then
MkDir strFilepath
End If
strFilepath = strRootPath & "Results\" & strMonth & " " & intDay & "\"
If Dir(strFilepath, vbDirectory) = "" Then
MkDir strFilepath
End If
strFilePathIncorrect = strFilepath & "Incorrect References\"
If Dir(strFilePathIncorrect, vbDirectory) = "" Then
MkDir strFilePathIncorrect
End If
'get Excel object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
On Error GoTo 0
objExcel.Visible = False
'create summary file from template
strTemplateName = "C:\Desktop\Practice Runs\Templates\Summary template.xlsm"
strSummaryFilename = strFilepath & "Results Summary - " & strMonth & " " & intDay & " " & intYear & ".xlsm"
oFSO.copyfile strTemplateName, strSummaryFilename, True
Set xlWorkbook = objExcel.Workbooks.Open(strSummaryFilename)
'process query and export results to excel files
strDirectory = strFilePathIncorrect
strQueryName = "Query1"
strFilename = strDate & " Incorrect Results.xlsx"
strFullFilepath = strDirectory & strFilename
strWorksheetName = "Incorrect"
intCount = ProcessQuery(rs, strQueryName, strFullFilepath, strWorksheetName, xlWorkbook, blnExportToResultsSummary:=True)
'...some more processing of intCount...
'...process more queries...
'clean up
rs.Close
Set rs = Nothing
xlWorkbook.Close SaveChanges:=True
Set xlWorkbook = Nothing
If blnEXCEL = True Then
objExcel.Quit
End If
Set objExcel = Nothing
Set oFSO = Nothing
db.Close
Set db = Nothing
MsgBox "Check Completed"
End Sub
Function ProcessQuery(rs As Object, strQueryName As String, strFullFilepath As String, strWorksheetName As String, xlWorkbook As Object, blnExportToResultsSummary As Boolean)
Set rs = CurrentDb.OpenRecordset("Select * from [" & strQueryName & "]")
If rs.EOF = False Then
rs.MoveLast
ProcessQuery = rs.recordCount
ExportToExcel rs, strFullFilepath, "", Nothing 'export query results to Excel file in the specified folder
If blnExportToResultsSummary = True Then 'export query results to specified sheet in results summary file
ExportToExcel rs, , strWorksheetName, xlWorkbook
End If
Else
ProcessQuery = rs.recordCount 'no records found
End If
End Function
Sub ExportToExcel(rs As Object, Optional ByVal strFilepath As String = "", Optional ByVal strWorksheetName As String = "", Optional ByVal xlSummaryFile As Object = Nothing)
Dim objExcel As Excel.Application
Dim xlWorksheet As Excel.worksheet
Dim xlWorkbook As Excel.Workbook
Dim rngCurrentCell As Excel.Range
Dim lngColumn As Long
If strWorksheetName = "" Then 'export recordset to Excel file in the appropriate folder
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If objExcel = "" Then
Set objExcel = CreateObject("Excel.Application")
End If
objExcel.ScreenUpdating = False
objExcel.Visible = False
'if file already exists, delete it
If Dir(strFilepath) <> "" Then
Kill strFilepath
End If
Set xlWorkbook = objExcel.Workbooks.Add
xlWorkbook.SaveAs FileName:=strFilepath
Set xlWorksheet = xlWorkbook.Sheets(1)
Set rngCurrentCell = xlWorksheet.Range("A1")
'write headers to worksheet
For lngColumn = 0 To rs.Fields.Count - 1
rngCurrentCell.Offset(0, lngColumn).Value = rs.Fields(lngColumn).Name
Next lngColumn
Set rngCurrentCell = rngCurrentCell.Offset(1, 0)
' write data to worksheet
rs.MoveFirst
rngCurrentCell.CopyFromRecordset rs
FormatWorksheets xlWorksheet, blnNotesColumn:=False 'THIS CALL DOESN'T CAUSE BACKGROUND PROCESS TO HANG AROUND
objExcel.DisplayAlerts = False
xlWorkbook.Close SaveChanges:=True
objExcel.DisplayAlerts = True
Else 'export recordset to specified sheet in summary file
Set xlWorksheet = xlSummaryFile.Worksheets(strWorksheetName)
xlWorksheet.Cells.Clear
Set rngCurrentCell = xlWorksheet.Range("A1")
'write headers to worksheet
For lngColumn = 0 To rs.Fields.Count - 1
rngCurrentCell.Offset(0, lngColumn).Value = rs.Fields(lngColumn).Name
Next lngColumn
Set rngCurrentCell = rngCurrentCell.Offset(1, 0)
' write data to worksheet
rs.MoveFirst
rngCurrentCell.CopyFromRecordset rs
FormatWorksheets xlWorksheet, blnNotesColumn:=True 'CALLING THIS CAUSES BACKGROUND PROCESS TO HANG AROUND
xlSummaryFile.Save
End If
rs.MoveFirst
Set rngCurrentCell = Nothing
Set xlWorksheet = Nothing
Set xlWorkbook = Nothing
Set objExcel = Nothing
End Sub
Sub FormatWorksheets(xlWorksheet As Object, blnNotesColumn As Boolean)
With xlWorksheet
.Activate
.Range("A1").Select
Selection.End(xlToRight).Select 'sometimes causes run-time error 462
.Range("A1:" & ActiveCell.Address).Font.Bold = True
Selection.End(xlDown).Select
.Cells.EntireColumn.AutoFit
If blnNotesColumn = True Then
'Add notes column
.Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = "Notes"
ActiveCell.ColumnWidth = 60
ActiveCell.Font.Bold = True
End If
'Add borders to entire used area
.UsedRange.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
'Format date column
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, -2).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
Range("A1").Select
End With
End Sub
