Export Access to Excel with Custom Headers

Hello there! If you are new here, you might want to subscribe to the RSS feed for updates on this topic.

Have you noticed how the “out the box” solution to export your dataset from MS Access to MS Excel doesn’t give much room to give custom headers to your worksheet?

Through utlising ActiveX you can instantiate a copy of MS Excel in memory to add in your own custom headers etc. prior to exporting your MS Access dataset into the worksheet.

The below code example shows you how to add 5 custom headers to your sheet. Just add in your own SQL query where it is indicated.

Private Sub btn_export_excel_Click()
   
    Dim mySQL, thepos, theleft, theright, test As String
    Dim i, iNumCols  As Integer
    Dim DB As DAO.Database
    Dim rs As DAO.Recordset
    
    Set DB = CurrentDb
    
    With Me.yourformname.Form.RecordsetClone
        If .RecordCount > 0 Then .MoveLast
        test = .RecordCount
    End With
    
    If test < 65535 Then
        'create output table and output
        If MsgBox("Export selected data?", vbOKCancel, "Export . . ?") = vbOK Then
            
            Dim oApp As New Excel.Application
            Dim oBook As Excel.Workbook
            Dim oSheet As Excel.Worksheet
            Dim oRange As Excel.Range
			
			mySQL = "enter in whatever youSQL query is here"
                  
            Set rs = DB.OpenRecordset(mySQL, dbOpenSnapshot)
            Set oBook = oApp.Workbooks.Add
            Set oSheet = oBook.Worksheets(1)
            
            oSheet.Cells(1, 1).Value = "HEADER 1"
            oSheet.Cells(2, 1).Value = "HEADER 2"
            oSheet.Cells(3, 1).Value = "HEADER 3"
            oSheet.Cells(4, 1).Value = "HEADER 4"
            oSheet.Cells(5, 1).Value = "HEADER 5"
            
            'Format the header
            oSheet.Cells(1, 1).Font.Bold = True
            
            With oSheet
                Set oRange = .Range("A5:AL5")
            End With
            
            With oRange
                .MergeCells = True
            End With
           
            'Add the field names in row 7
            iNumCols = rs.Fields.count
            For i = 1 To iNumCols
                oSheet.Cells(7, i).Value = rs.Fields(i - 1).Name
            Next
            
            'Add the data starting at cell A8
            oSheet.Range("A8").CopyFromRecordset rs
            
            'Format the header row as bold and autofit the columns
            With oSheet.Range("a7").Resize(1, iNumCols)
                .Font.Bold = True
                .EntireColumn.AutoFit
            End With
            oSheet.Columns("A:A").ColumnWidth = 10.14
            
            oApp.Visible = True
            oApp.UserControl = True
            
            'make sure we clean up the instantiated Excel app!!
            'oApp.Quit
            Set oApp = Nothing
            Set oBook = Nothing
            Set oSheet = Nothing
            rs.Close
            DB.Close
            
        End If
    Else
        MsgBox "Sorry - your export is larger than what can be held within Excel!" & vbCrLf & vbCrLf & " Please consider revising your dataset.", vbCritical, "Export Error"
    End If
    
End Sub

Click here to cancel reply.

You must be logged in to post a comment.

Jul200920

Leave a Reply

Login

Recent Developments

Categories

Recent Comments

External Links

Archives

Most Popular Articles

Jul200920