How To Do An Access Export To Excel In VBA

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’ll see the data we will be exporting 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.

By the way, if you got or are getting value from the VBA information, please give me a tip, thanks!