Exporting Access Data to Excel, Part 1

There are several built-in ways to export Access data to Excel.

There are several built-in ways to export Access data to Excel.  You can use the Excel button on the Ribbon (or toolbar) to export a report (or other object) to Excel, or the TransferSpreadsheet method in code, to transfer data from the report’s record source.  These methods are useful if you just need a basic data dump, say for allowing a person who doesn’t have Access to proofread data and do some calculations using Excel features.  There are a few differences between the workbooks created by these two methods:  the Excel button (using the OutputTo method) creates a worksheet with the same font as the report and the title at the top (if there is one), and totals rows; however, group headings, repeating rows, and graphics are not carried over, and group totals appear in the wrong column, with the wrong label, and there is no page break after each group (if you had one in the report).

Figure A shows a workbook exported from a report’s record source by the TransferSpreadsheet method; Figure B shows the same report exported to a workbook using the Excel button on the Ribbon.

Figure A.  A workbook created by the Excel button on the Ribbon

Figure B.  A workbook exported by the TransferSpreadsheet method

If you want something more elegant (and useful) than just a workbook filled with Access data, you need to write code to create a workbook from a template, and fill it with data from Access, and possibly do some further manipulations in code, using components of the Excel object model in Automation code.


Exporting Data from a Single Source to Excel

The first step for doing an export of Access data to an attractively formatted Excel workbook is to prepare an Excel template with the desired formatting, for use in creating new workbooks in VBA code.  I first created the Excel templates as .xlt templates in Excel 2007, using some of the subtler shades available in this version of Excel, but I found that these colors were stripped out when the templates (or workbooks made from them) were opened in older versions of Excel, so I made two versions of each template, one in .xltx format, using the subtle shades, and one in .xlt format, using shades available in Excel 2003.

The main menu of the sample database, Exporting Access Data to Excel, has an option group for selecting the output method, From Date and To Date textboxes for selecting or entering dates for a date range, a combo box listing the available reports, and folder path selectors for selecting the folder where the templates are stored and the folder where you want the workbooks to be saved.  The dates and folder paths are stored to custom database properties for use in code (for more details on this method, see Access Archon #152).

Figure C.  The main menu with various options for reports

If you select the TransferSpreadsheet Method option, and select a report to export, then click the large Report button, you will get a workbook like the one shown in Figure B above; if you select the OutputTo method, you will get a workbook like the one shown in Figure A.  For the single source reports, if all you need is the data, the workbook may be useful, but if you select the Sales by Manager and Employee report, which is based on linked tables, the resulting workbook is pretty much useless, as the grouping and sorting is totally lost:

Figure D.  A grouped report exported by the TransferSpreadsheet method

When exported by the OutputTo method, the resulting workbook is even less useful.  Although it is grouped, the group headers are omitted, extra columns are inserted between columns, and the subtotals are under the wrong columns:

Figure E.  A grouped report exported by the OutputTo method


VBA Code

The code for creating the reports using the TransferSpreadsheet and OutputTo methods is listed below:

Public Sub ToolbarExport(strReport As String)
 
On Error GoTo ErrorHandler
 
   strXLWorksheetsPath = GetProperty(“XLWorksheetsPath”, “”) & “”
   
   ‘Test whether saved templates folder path is correct
   If TestFolderExists(strXLWorksheetsPath) = False Then
      GoTo ErrorHandlerExit
   End If
   
   Debug.Print “Worksheets path: ” & strXLWorksheetsPath
   strWorkbook = strXLWorksheetsPath & Mid(strReport, 4) _
      & ” (OutputTo Method).xls”
   DoCmd.OpenReport reportname:=strReport, _
      view:=acViewDesign, _
      windowmode:=acHidden
   DoCmd.OutputTo objecttype:=acOutputReport, _
      objectname:=strReport, _
      outputformat:=acFormatXLS, _
      outputfile:=strWorkbook
   DoCmd.Close objecttype:=acReport, _
      objectname:=strReport
   
   strTitle = “Report exported”
   strPrompt = “Report exported to ” & strWorkbook
   MsgBox prompt:=strPrompt, _
      Buttons:=vbInformation + vbOKOnly, _
      Title:=strTitle
   
ErrorHandlerExit:
   Exit Sub
 
ErrorHandler:
   MsgBox “Error No: ” & Err.Number _
      & ” in ToolbarExport procedure; ” _
      & “Description: ” & Err.Description
   Resume ErrorHandlerExit
 
End Sub
 
Public Sub TransferReportToExcel(strReport As String)
 
On Error GoTo ErrorHandler
 
   strXLWorksheetsPath = GetProperty(“XLWorksheetsPath”, “”) & “”
   Debug.Print “Worksheets path: ” & strXLWorksheetsPath
   
   ‘Test whether saved templates folder path is correct
   If TestFolderExists(strXLWorksheetsPath) = False Then
      GoTo ErrorHandlerExit
   End If
   
   strWorkbook = strXLWorksheetsPath & Mid(strReport, 4) _
      & ” (TransferSpreadsheet Method).xls”
   DoCmd.OpenReport reportname:=strReport, _
      view:=acViewDesign, _
      windowmode:=acHidden
   strSQL = Reports(strReport).RecordSource
   Debug.Print “Workbook: ” & strWorkbook
   DoCmd.TransferSpreadsheet transfertype:=acExport, _
      spreadsheettype:=acSpreadsheetTypeExcel9, _
      tablename:=strSQL, _
      FileName:=strWorkbook, _
      hasfieldnames:=True
   DoCmd.Close objecttype:=acReport, _
      objectname:=strReport
   
   strTitle = “Report exported”
   strPrompt = “Report exported to ” & strWorkbook
   MsgBox prompt:=strPrompt, _
      Buttons:=vbInformation + vbOKOnly, _
      Title:=strTitle
   
ErrorHandlerExit:
   Exit Sub
 
ErrorHandler:
   MsgBox “Error No: ” & Err.Number _
      & ” in TransferReportToExcel procedure; ” _
      & “Description: ” & Err.Description
   Resume ErrorHandlerExit
 
End Sub

For better results with all types of reports – but especially with grouped reports – I recommend using VBA Automation code working with components of the Excel object model to create a new workbook from an Excel template, and then fill it with data from Access.  For single source reports, this is a fairly simple process.  The first and last parts of the CreateReport procedure, and the Case that creates a worksheet equivalent of rptSalesByEmployee, is listed below:

Public Sub CreateWorkbook(strReport As String, strDisplayName As String, _
   strRecordSource As String)
 
On Error GoTo ErrorHandler
 
   Dim appExcel As Excel.Application
   Dim brk As Excel.HPageBreak
   Dim i As Integer
   Dim lngCount As Long
   Dim lngCurrentRow As Long
   Dim lngEndRow As Long
   Dim lngRow As Long
   Dim lngStartRow As Long
   Dim lngSectionRows As Long
   Dim lngSectionStartRow As Long
   Dim n As Long
   Dim objFind As Object
   Dim rng As Excel.Range
   Dim rngData As Excel.Range
   Dim rngCollectors As Excel.Range
   Dim rngHeader As Excel.Range
   Dim rngStart As Excel.Range
   Dim rstEmployees As DAO.Recordset
   Dim rstTeamLeaders As DAO.Recordset
   Dim rstTeamMembers As DAO.Recordset
   Dim strHeaderRange As String
   Dim strXLTemplatesPath As String
   Dim strXLWorksheetsPath As String
   Dim strPrompt As String
   Dim strDataRange As String
   Dim strRange As String
   Dim strSaveName As String
   Dim strWorkbookName As String
   Dim strSumRange As String
   Dim strTeamLeader As String
   Dim strTeamLeadersQuery As String
   Dim strTeamQuery As String
   Dim strTemplate As String
   Dim strTemplateFile As String
   Dim strTemplatesPath As String
   Dim strTitle As String
   Dim wkb As Excel.Workbook
   Dim wks As Excel.Worksheet
   Dim strDateRange As String
   
   ‘Create new worksheet from template and export data to it
   strXLTemplatesPath = GetProperty(“XLTemplatesPath”, “”) & “”
   Debug.Print “Templates folder: ” & strXLTemplatesPath
   strXLWorksheetsPath = GetProperty(“XLWorksheetsPath”, “”) & “”
   Debug.Print “Worksheets path: ” & strXLWorksheetsPath
   
   If Left(Application.Version, 2) = “12” Then
      strTemplate = Mid(strReport, 4) & “.xltx”
   Else
      strTemplate = Mid(strReport, 4) & “.xlt”
   End If
   
   ‘Test whether template is found in the Templates folder
   strTemplateFile = strXLTemplatesPath & strTemplate
   If TestFileExists(strTemplateFile) = False Then
      strTitle = “Template not found”
      strPrompt = “Excel template ‘” & strTemplate _
         & “‘ not found in ” & strXLTemplatesPath & “;” & vbCrLf _
         & “please put template in this folder and try again”
      MsgBox strPrompt, vbCritical + vbOKOnly, strTitle
      GoTo ErrorHandlerExit
   Else
      Debug.Print “Excel template used: ” & strTemplateFile
   End If
 
   Set appExcel = GetObject(, “Excel.Application”)
   Set wkb = appExcel.Workbooks.Add(strTemplateFile)
   Set wks = wkb.Sheets(1)
   wks.Activate
   appExcel.Visible = True
   
   ‘Write date range subtitle to cell A3
   If GetProperty(“StartDate”, “”) = GetProperty(“EndDate”, “”) Then
      strDateRange = “For the date ” _
      & Format(GetProperty(“StartDate”, “”), “d-mmm-yyyy”)
   Else
      strDateRange = “For the Period from ” _
         & Format(GetProperty(“StartDate”, “”), “d-mmm-yyyy”) _
         & ” to ” & Format(GetProperty(“EndDate”, “”), “d-mmm-yyyy”)
   End If
   
   Debug.Print “Date range subtitle: ” & strDateRange
   Set rng = wks.Range(“A3”)
   rng.Value = strDateRange
   
   Set dbs = CurrentDb
   
   Select Case strReport
   
      Case “rptSalesByEmployee”
         Set rst = dbs.OpenRecordset(strRecordSource)
         
         ‘Go to first data cell
         Set rngStart = wks.Range(“A7”)
         Set rng = wks.Range(“A7”)
         
         ‘Reset lngCount to number of records in query
         rst.MoveLast
         rst.MoveFirst
         lngCount = rst.RecordCount
         Debug.Print “No. of records: ” & lngCount
         
         For n = 1 To lngCount
            ‘Write data from recordset to worksheet
            rng.Value = Nz(rst![EmployeeID])
            Set rng = rng.Offset(columnoffset:=1)
            rng.Value = Nz(rst![EmployeeName])
            Set rng = rng.Offset(columnoffset:=1)
            rng.Value = Nz(rst![Blue])
            Set rng = rng.Offset(columnoffset:=1)
            rng.Value = Nz(rst![Red])
            Set rng = rng.Offset(columnoffset:=1)
            rng.Value = Nz(rst![Green])
            Set rng = rng.Offset(columnoffset:=1)
            rng.Value = Nz(rst![Purple])
            Set rng = rng.Offset(columnoffset:=1)
            rng.Value = Nz(rst![Yellow])
            
            ‘Go to next row
            rst.MoveNext
            Set rng = rngStart.Offset(rowoffset:=n)
         Next n
         
         ‘Determine number of data rows in worksheet
         lngEndRow = wks.UsedRange.Rows.Count
         Debug.Print “Last data row in worksheet: ” & lngEndRow
         
         ‘Set data range
         strDataRange = “A7:G” & CStr(lngEndRow)
         Set rngData = wks.Range(strDataRange)
         
         ‘Apply hairline borders to data range
         Call ApplyBorders(rngData)
         lngStartRow = 7
      
         ‘Create Totals row
         lngRow = lngEndRow + 2
         Debug.Print “Totals row: ” & lngRow
         strRange = “B” & CStr(lngRow)
         Set rng = wks.Range(strRange)
         rng.Value = “Totals:”
         rng.Font.Bold = True
         rng.Font.Size = “12”
         rng.Font.Italic = True
         rng.HorizontalAlignment = xlRight
         
         Set rng = rng.Offset(columnoffset:=1)
         strSumRange = “C” & CStr(lngStartRow) & “:C” & CStr(lngEndRow)
         Debug.Print “Sum range: ” & strSumRange
         rng.Formula = “=SUM(” & strSumRange & “)”
         rng.Font.Bold = True
         
         Set rng = rng.Offset(columnoffset:=1)
         strSumRange = “D” & CStr(lngStartRow) & “:D” & CStr(lngEndRow)
         Debug.Print “Sum range: ” & strSumRange
         rng.Formula = “=SUM(” & strSumRange & “)”
         rng.Font.Bold = True
         
         Set rng = rng.Offset(columnoffset:=1)
         strSumRange = “E” & CStr(lngStartRow) & “:E” & CStr(lngEndRow)
         Debug.Print “Sum range: ” & strSumRange
         rng.Formula = “=SUM(” & strSumRange & “)”
         rng.Font.Bold = True
         
         Set rng = rng.Offset(columnoffset:=1)
         strSumRange = “F” & CStr(lngStartRow) & “:F” & CStr(lngEndRow)
         Debug.Print “Sum range: ” & strSumRange
         rng.Formula = “=SUM(” & strSumRange & “)”
         rng.Font.Bold = True
         
         Set rng = rng.Offset(columnoffset:=1)
         strSumRange = “G” & CStr(lngStartRow) & “:G” & CStr(lngEndRow)
         Debug.Print “Sum range: ” & strSumRange
         rng.Formula = “=SUM(” & strSumRange & “)”
         rng.Font.Bold = True
         [code omitted]
   End Select
   
SaveAndClose:
   ‘Save and close filled-in worksheet, using workbook
   ‘save name with date range
   If CInt(Left(Application.Version, 2)) < 12 Then
      strWorkbookName = strDisplayName & ” ” & strDateRange & “.xls”
   Else
      strWorkbookName = strDisplayName & ” ” & strDateRange & “.xlsx”
   End If
   
   Debug.Print “Sheet name: ” & strWorkbookName
   strSaveName = strXLWorksheetsPath & strWorkbookName
   Debug.Print “Save name: ” & strSaveName
   
On Error Resume Next
   ‘If there already is a saved worksheet with this name,
   ‘delete it
   Kill strSaveName
   
On Error GoTo ErrorHandler
   ‘Select file format depending on Excel version running
   wkb.SaveAs FileName:=strSaveName
   ‘Uncomment the line below to close the workbook after it is created
   ‘wkb.Close
   
   If Not rst Is Nothing Then
      rst.Close
      Set rst = Nothing
   End If
   
   strTitle = “Workbook created”
   strPrompt = strWorkbookName & ” created in ” & strXLWorksheetsPath
   MsgBox prompt:=strPrompt, _
      Buttons:=vbInformation + vbOKOnly, _
      Title:=strTitle
 
ErrorHandlerExit:
   Set appExcel = Nothing
   Set rst = Nothing
   Exit Sub
 
ErrorHandler:
   If Err.Number = 429 Then
      Set appExcel = CreateObject(“Excel.Application”)
      Resume Next
   Else
      MsgBox “Error No: ” & Err.Number _
         & ” in CreateWorkbook procedure; ” _
         & “Description: ” & Err.Description
      Resume ErrorHandlerExit
   End If
 
End Sub

The code for rptSalesByManager is very similar. 

Here is a screen shot of a Sales by Employee workbook created by this code:

Figure F.  The Sales by Employee workbook

The Sales by Manager workbook is similar:

Figure G.  The Sales by Manager workbook


References

The code in the sample database needs the following references (in addition to the default references):

Microsoft DAO 3.6 Object Library

Microsoft Scripting Runtime

Microsoft Excel 11.0 Object Library

If you import code or objects into a database of your own, you may need to set one or more of these references.  The version number may differ, depending on your Office version; check the version you have.  References are set in the References dialog, opened from the VBA window.  For more information on working with references, see Access Archon #107, Working with References.


Supporting Files

The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch200.zip, which is the last entry in the table of Access Archon columns for Access Watch.



















Document Name

Document Type

Place in

Exporting Access Data to Excel (AA 200).mdb

Access 2002-2003 database (can also be used in higher versions of Access)

Wherever you want

SalesByEmployee.xltx

SalesByManager.xltx

SalesByManagerAndEmployee.xltx

Excel 2007-2010 templates

In the Templates folder selected on the main menu

SalesByEmployee.xlt

SalesByManager.xlt

SalesByManagerAndEmployee.xlt

Excel 97-2003 templates

In the Templates folder selected on the main menu

Want More?

Office Watch has the latest news and tips about Microsoft Office.  Delivered once a week.