In this post, we are going to do an Access export to Excel, and you’ll see the VBA we’ll work with.
This Excel automation will create a worksheet for each of our data points, and then enter the row items for that data point.
We are going to let Access do most of the querying and “heavy lifting”, because that’s what it’s pretty good at.
So rather than create a few small queries and trying to link them in Excel, we will do all the linking in one Access query and send that result over to Excel.
In this image you are going to find out that the data for the query is coming from multiple tables. So the idea is to join all the table data in Access, and then send it to Excel
The query here is going to be called “qryUnresolvedExcel”, and its sole purpose is to gather the data necessary for the Excel export.
In the beginning the Excel workbook will only have one worksheet “Main”:
The comments on the code will help decipher what going on:
Private Sub btnExcel_Click() ExcelExport MsgBox "Excel Export Complete" End Sub Private Sub ExcelExport() Dim rst As Recordset Dim rstUnique As Recordset Dim strSQL As String 'Dim objExcelBook As Excel.Workbook 'Dim objExcelSheet As Excel.Worksheet 'USING EARLY BINDING 'Dim objExcelApp As Excel.Application 'Dim objExcelBook As Excel.Workbook 'Dim objExcelSheet As Excel.worksheet ''USING LATE BINDING Dim objExcelApp As Object Dim objExcelBook As Object Dim objExcelSheet As Object Dim strTemplate As String Dim intExcelMainRow As Integer Dim intExcelMainColumn As Integer Dim intExcelDetailRow As Integer Dim intExcelDetailColumn As Integer Dim strWhere As String Dim strSQLUnique As String Dim intCaccRows As Integer Dim strMainSheet As String Dim strNewSheet As String strTemplate = CurrentProject.Path & "\report.xlsx" 'Set m_objExcelApp = New Excel.Application On Error Resume Next DoCmd.Hourglass True If Len(Me.Filter) = 0 Then strSQLUnique = "SELECT DISTINCT CACC FROM qryUnresolvedExcel " Else strSQLUnique = "SELECT DISTINCT CACC FROM qryUnresolvedExcel WHERE " & Me.Filter End If '------------------------------------------------------------- Set rstUnique = CurrentDb.OpenRecordset(strSQLUnique) 'this is a sheet in the Excel Workbook strMainSheet = "Main" If Not rstUnique.EOF Then 'Set the Excel row to start at: intExcelMainRow = 8 'Set the Excel column to start at: intExcelMainCol = 3 'get the number of rows in the new recordset intCaccRows = rstUnique.RecordCount 'this results in an error, not fatal so resume Set objExcelApp = GetObject(, "Excel.Application") If objExcelApp Is Nothing Then Set objExcelApp = CreateObject("Excel.Application") End If Set objExcelBook = objExcelApp.Workbooks.Add(strTemplate) Set objExcelSheet = objExcelBook.Worksheets(strMainSheet) 'let's see the Excel sheet as it's being populated objExcelApp.Visible = True 'enter the number of rows we are working with objExcelSheet.Range("B7") = intCaccRows Do Until rstUnique.EOF 'always write the new sheet value on the main worksheet strSheet = strMainSheet Set objExcelSheet = objExcelBook.Worksheets(strSheet) objExcelSheet.Cells(intExcelMainRow, intExcelMainCol) = rstUnique.Fields("CACC") 'the new worksheet will by called this strNewSheet = rstUnique.Fields("CACC") 'make a new worksheet for each new CACC If objExcelBook.Sheets(strNewSheet).Name <> "" Then 'worksheet does not exist, create it objExcelBook.Sheets.Add(After:=objExcelBook.Sheets(objExcelBook.Sheets.Count)).Name = strNewSheet End If '**************************************************** 'now add all the detail information for each CACC '**************************************************** strSheet = strNewSheet Set objExcelSheet = objExcelBook.Worksheets(strSheet) 'if there is a form filter, we have a where clause If Len(Me.Filter) = 0 Then strSQL = "SELECT * FROM qryUnresolvedExcel WHERE CACC = '" & strNewSheet & "'" Else strSQL = "SELECT * FROM qryUnresolvedExcel WHERE CACC = '" & strNewSheet & "' AND " & Me.Filter End If Set rst = CurrentDb.OpenRecordset(strSQL) If Not rst.EOF Then 'this is the main data for each datapoint (sheet) item objExcelSheet.Range("A1") = "Employee: " objExcelSheet.Range("A2") = "Date: " objExcelSheet.Range("A1").Font.Bold = 1 objExcelSheet.Range("A1").Font.Underline = True objExcelSheet.Range("A1").Font.Name = "Calibri" objExcelSheet.Range("A2").Font.Bold = 1 objExcelSheet.Range("A2").Font.Name = "Calibri" objExcelSheet.Range("A2").Font.Underline = True objExcelSheet.Range("B1") = rst.Fields("ServName") objExcelSheet.Range("B2") = rst.Fields("InspDate") objExcelSheet.Range("B2").NumberFormat = "mmmm d, yyyy" '"m/d/yyyy" 'Set the Excel row to start at: intExcelDetailRow = 8 'Set the Excel column to start at: intExcelDetailCol = 3 'enter the line items for the datapoint Do Until rst.EOF objExcelSheet.Cells(intExcelDetailRow, intExcelDetailCol) = rst.Fields("Finding") objExcelSheet.Cells(intExcelDetailRow, intExcelDetailCol + 2) = rst.Fields("CheckList") intExcelDetailRow = intExcelDetailRow + 1 rst.MoveNext Loop 'autofit the cell and center the data objExcelSheet.Columns("C:C").AutoFit objExcelSheet.Columns("C:C").HorizontalAlignment = -4108 'xlCenter rst.Close Else rst.Close Set rst = Nothing End If '**************************************************** intExcelMainRow = intExcelMainRow + 1 rstUnique.MoveNext Loop Else intCaccRows = 0 End If 'CLOSE EXCEL REFERENCES: Set objExcelSheet = Nothing Set objExcelBook = Nothing 'objExcelApp.Quit 'Set objExcelApp = Nothing DoCmd.Hourglass False End Sub
After we are done running our VBA process, we will have an Excel Workbook with multiple sheets:
You can do the same type of Access export to Excel VBA by recreating the above datasheet in a table, and then run the code above.
Let me know if you have questions, and remember that sharing is nice, and may help someone else.
