We help IT Professionals succeed at work.

Query results button to Excel

99 Views
Last Modified: 2018-09-06
I have an Access database and in it I have a form that people can use to search information.  After they put in the parameters they hit the apply search button and it gives them the information.  I need to create a button that would export the current search results in the form to Excel.  Any suggestions??

Ok.  I finally got it to work but the export also includes the filter boxes that I have on the form.  Is there a way to exclude certain fields?
Comment
Watch Question

CERTIFIED EXPERT

Commented:
you can have the query look for controls in your form as parameters, and then use docmd.transferspreadsheet
https://docs.microsoft.com/en-us/office/vba/api/access.docmd.transferspreadsheet
CERTIFIED EXPERT
Distinguished Expert 2017

Commented:
If you want different data exported than what is being viewed on the form, you will need to make two queries.
IT Supervisor
CERTIFIED EXPERT
Distinguished Expert 2019
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2013

Commented:
It's not clear how your form and the search button work.  Are the search results displayed on a bound form?  In a list box...?  What is the code behind the button?

The code behind the button probably creates a SQL WHERE clause which is then applied to either the form's record source or a listbox's rowsource property.  If you want to export a different collection of fields to Excel, you extend your code to create an SQL statement like this:

dim s as string
' sCrit is the criteria that I'm guessing your command button creates to filter your data
s = "SELECT Field1 as [User Friendly Column Heading], Field2 AS  [Another Column Heading] FROM YourTableOrQuery WHERE " &  sCrit  

Open in new window


Then you can call code to export the SQL string to Excel (The function at the end of this post is one I've used for similar tasks):
If GenericExcelReport(s, "My Excel Report Title") = true then
       msgbox "Export Done"
Else
      msgbox "Export Failed"
end if 

Open in new window


' Place this code in a separate module named modExcelExports
Function GenericExcelReport(sSelect As String, sTitle As String) As Boolean
'On Error GoTo ErrGenericExcelReport
    Const xlTop As Integer = -4160
    GenericExcelReport = False

    Dim db As Database
    Dim rsGeneric As DAO.Recordset
    
    Set db = CurrentDb
    Set rsGeneric = db.OpenRecordset(sSelect, dbOpenDynaset, dbSeeChanges)
    
    Dim ColCount As Integer
    Dim col As Integer
    Dim row As Integer
        
    'Dim oExcel As Excel.Application
    'Dim oWB As Excel.Workbook
    'Dim oWS As Excel.Worksheet
    
    Dim oExcel As Object
    Dim oWB As Object
    Dim oWS As Object
    
    'open the spreadsheet for editing
'On Error GoTo Excel_EH
    If oExcel Is Nothing Then Set oExcel = CreateObject("Excel.Application") 'New Excel.Application
    oExcel.Visible = True
    Set oWB = oExcel.Workbooks.Add
    Set oWS = oExcel.ActiveSheet

    
'On Error GoTo ErrGenericExcelReport

    DoEvents
    
    ColCount = rsGeneric.Fields.Count
    row = 1
    col = 0
    With oWS
                     
        If (sTitle & "" <> "") Then row = row + 2       'set up for the title if there is one
        
        .rows(row).Font.Bold = True
        
        'set up the Column Headings and
        Do While (col < ColCount)
            .cells(row, col + 1).Value = rsGeneric.Fields(col).Name
            
            'check if this field type is Date/Time
            If rsGeneric.Fields(col).Type = 8 Then
                'next line requires more checking, the property may not exist for each date field
                'If (rsGeneric.Fields(col).Properties("Format") = "Short Date") then .Columns(col + 1).NumberFormat = "m/d/yyyy;@"
                .Columns(col + 1).NumberFormat = "[$-409]yyyy-mm-dd"
            End If
            
            'check if this field type is Currency
            If rsGeneric.Fields(col).Type = 5 Then
               .Columns(col + 1).NumberFormat = "$#,##0.00"
            End If
                
            col = col + 1
        Loop
        
        'output the data
        If rsGeneric.EOF Then
            row = row + 1
            col = 0
            .cells(row, col + 1).Value = "There are no records to display."
            .range(.cells(row, col + 1), .cells(row, ColCount)).merge
        End If
        
        Do While Not rsGeneric.EOF
            row = row + 1
            col = 0
            Do While (col < ColCount)
                .cells(row, col + 1).Value = rsGeneric.Fields(col)
                col = col + 1
            Loop
                        
            rsGeneric.MoveNext
        Loop
        
    
        .cells.EntireColumn.AutoFit
        .cells.EntireRow.AutoFit
        .cells.EntireRow.VerticalAlignment = xlTop
       
        If (sTitle & "" <> "") Then
            row = 1
            col = 0
            .rows(row).Font.Bold = True
            .cells(row, col + 1).Value = sTitle
            .cells(row, col + 1).WrapText = False
            .cells(row, col + 1).Font.Size = 14
        End If
        
    End With


    GenericExcelReport = True

Exit Function

Excel_EH:
    DoEvents
    DoEvents
    MsgBox "An error occurred. Please close excel and try running the process again.", vbExclamation, "No Page Break Inserted"
Exit Function

ErrGenericExcelReport:
    MsgBox "An error occured while attempting to generate the report." & vbCrLf & Err.Number & ": " & Err.Description
Exit Function
    
End Function

Open in new window

lrollinsIT Manager

Author

Commented:
Thanks John.  That worked great!