Access JumpStart 2.0 | Blog

A Rapid Development Framework for Microsoft Access

I utilized a couple of library routines I built to manage an Excel export.

Step 1 – Get an Excel object from a function which opens a particular xlsx file as a template, then copies it to a new file name given by the function. I have other functions which can use the system file dialogs to select a name for a new file which defaults the location to their user profile documents folder.

Step 2 – Pass a sheet name (1st sheet by default) and a query or table name along with numerical values for starting row and starting column. By default it starts in row 2 (to allow for column headers) and column 1. The function then uses the Excel app object from step 1 and copies in the query or table data using DAO.

Step 3 – Use a final function to save and close the Excel file and set the instance to Nothing.

Here’s the class I use from the library to do these things:

' ------------------------------------------------------
' Name: HAL_Excel
' Kind: Class Module
' Purpose: Update Excel file templates
' Author: jon
' Date: 10/2/2019
' ------------------------------------------------------
Option Compare Database    'Use database order for string comparisons
Option Explicit 
'Option Private Module    ' Keep this module from showing in the auto-complete list

' Code to Late Bind Excel to avoid problems with different Excel versions
' 0 if Late Binding
' 1 if Reference to Excel set.
#Const ExcelRef = 0 

' ----------------------------------------------------------------
' Procedure Name: HAL_ExportToExcelSelectTemplate
' Purpose: Takes a path to an Excel template, copies it to the
'          Output File Name, then returns a handle to it
' Procedure Kind: Function
' Procedure Access: Public
' Parameter strFullyQualifiedTemplateFile (String):
' Parameter strFullyQualifiedOutputFileName (String):
' Return Type: Object
' Author: jon
' Date: 10/2/2019
' ----------------------------------------------------------------
Public Function HAL_ExportToExcelSelectTemplate(strFullyQualifiedTemplateFile As String,strFullyQualifiedOutputFileName As String) As Object 
   On Error GoTo Proc_Err 

#If ExcelRef = 0 Then  ' Late binding
    
   If HALutil.ReferenceLibraryExists( "Excel") Then References.Remove References!Excel 
    
   Dim objExcel As Object 
   Set objExcel = CreateObject( "Excel.Application") 

#Else  ' a reference to MS Excel  Object Library must be specified
    
   Dim objExcel As Excel.Application 
   Set objExcel = New Excel.Application 

#End If 
    
   If Dir(strFullyQualifiedTemplateFile) =  "" Then 
      HALutil.MsgBox  "The required Excel Template spreadsheet (" & strFullyQualifiedTemplateFile &  ") does not exist.  Cannot continue.",vbExclamation + vbOKOnly 
      Set objExcel = Nothing 
      Exit Function 
   End If 
    
   objExcel.Workbooks.Open FileName:=strFullyQualifiedTemplateFile 
   'When asking for the file name to save to, we have already checked
   'to see if the user wanted to overwrite the file.  Excel will ask
   'again if they want to overwrite the existing file, so in order to
   'avoid this, we will just delete the file if it exists.
   If Dir(strFullyQualifiedOutputFileName) <>  "" Then 
      Kill (strFullyQualifiedOutputFileName) 
   End If 
   objExcel.ActiveWorkbook.SaveAs strFullyQualifiedOutputFileName 
    
   Set HAL_ExportToExcelSelectTemplate = objExcel 
    
   Exit Function 
   
   'Start error handlers
Proc_Err: 
   If Err.Number = 70 Then 
      HALutil.LibErrHandler ,,, "NOMSG"
      HALutil.MsgBox  "Could not overwrite " & vbCrLf & strFullyQualifiedOutputFileName & vbCrLf & _ 
         "Check to see if the file is currently open" & vbCrLf & _ 
         "And whether you have write access to the file"
      DoCmd.Hourglass False 
      'DoCmd.Close acForm, "frmWait"
      objExcel.Quit 
      Exit Function 
   Else 
      HALutil.LibErrHandler 
      DoCmd.Hourglass False 
      'DoCmd.Close acForm, "frmWait"
      objExcel.Quit 
      Exit Function 
   End If 

End Function 

' ----------------------------------------------------------------
' Procedure Name: HAL_ExportToExcelSheet
' Purpose: Imports the table or query data into the specified worksheet
'          starting at the specified row and column.  You can call it
'          multiple times with different sheet names and table or query values.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter objExcelApp (Object): handle to an Excel Workbook
' Parameter strTableOrQuery (Variant): query or table
' Parameter strSheetName (Variant): option sheet name
' Parameter intRowStart (Integer): optional starting parameter for the row
' Parameter intColumnStart (Integer): optional starting parameter for the column
' Author: jon
' Date: 10/2/2019
' ----------------------------------------------------------------
Public Sub HAL_ExportToExcelSheet(ByRef objExcelApp As Object,strTableOrQuery As Variant,_ 
   Optional strSheetName As Variant =  "",Optional intRowStart As Integer = 2,Optional intColumnStart As Integer = 1) 
#If ExcelRef = 0 Then  ' Late binding
    
   If HALutil.ReferenceLibraryExists( "Excel") Then References.Remove References!Excel 
    
   Dim objExcel As Object 

#Else  ' a reference to MS Excel  Object Library must be specified
    
   Dim objExcel As Excel.Application 

#End If 
   
   Set objExcel = objExcelApp 
   'objExcel.ScreenUpdating = False
   
   Dim DbCurrent As DAO.Database 
   Dim rsData As DAO.Recordset 
   Dim iRec As Integer,intColumn As Integer 
   'AJS.OpenForm "frmWait"
    
   'DoEvents
    
   DoCmd.Hourglass True 
   
   Set DbCurrent = CurrentDB 
   Set rsData = DbCurrent.OpenRecordset(strTableOrQuery) 
    
   If rsData.RecordCount <= 0 Then 
      HALutil.MsgBox  "No records match selection criteria",vbOKOnly + vbInformation, "MRP"
      rsData.Close 
      DbCurrent.Close 
      Set rsData = Nothing 
      Set DbCurrent = Nothing 
      objExcel.Quit 
      Exit Sub 
   End If 
    
   On Error GoTo 0 
    
   If strSheetName <>  "" Then objExcel.Sheets(strSheetName).Activate 
    
   iRec = intRowStart 
    
   Dim arrData As Variant,rowcount As Integer 
   rsData.MoveLast 
   rsData.MoveFirst 
   ReDim arrData(rsData.RecordCount - 1,rsData.Fields.Count - 1) 
   rowcount = 0 
   While Not rsData.EOF 
      For intColumn = 0 To rsData.Fields.Count - 1 
         arrData(rowcount,intColumn) = rsData(intColumn) 
      Next intColumn 
      rowcount = rowcount + 1 
      rsData.MoveNext 
   Wend 
    
   With objExcel 
      .Range(.Cells(iRec,intColumnStart),.Cells(iRec + rsData.RecordCount - 1,intColumnStart + rsData.Fields.Count - 1)).Value = arrData 
   End With 
    
   rsData.Close 
   Set rsData = Nothing 
   DbCurrent.Close 
   Set DbCurrent = Nothing 
    
   DoCmd.Hourglass False 
    
Exit_Err_cmdExport_Click: 
   Exit Sub 
    
Err_cmdExport_Click: 
   HALutil.MsgBox  "Error Number: " & Err.Number &  " " & Err.Description 
   Resume Exit_Err_cmdExport_Click 

End Sub 

' ----------------------------------------------------------------
' Procedure Name: HAL_ExportToExcelClose
' Purpose: Takes an Excel handle and closes it.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter objExcel (Object): handle of object to be closed
' Author: jon
' Date: 10/2/2019
' ----------------------------------------------------------------
Public Sub HAL_ExportToExcelClose(ByRef objExcel As Object) 
   objExcel.ActiveWorkbook.Save 
   objExcel.ActiveWorkbook.Close 
   objExcel.Quit 
   Set objExcel = Nothing 
End Sub