Query results button to Excel

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?
LVL 1
lrollinsIT ManagerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

bfuchsCommented:
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
0
PatHartmanCommented:
If you want different data exported than what is being viewed on the form, you will need to make two queries.
0
John TsioumprisSoftware & Systems EngineerCommented:
This is the code i use when i want to export data to Excel
Private Sub cmdExportToExcel_Click()
 On Error GoTo Err_cmdExcel_Click
    Dim rst As Object
    Const StartRow = 3
    Dim MaxRow As Integer
    Dim objXL As Object
    Dim objWkb As Object
    Dim objSht As Object

    Set rst = Me.Recordset.Clone
    rst.MoveLast
    rst.MoveFirst
    MaxRow = rst.RecordCount


Set objXL = CreateObject("Excel.Application")
    With objXL
        .Visible = True        
        Set objWkb = .Workbooks.Add
        Set objSht = objWkb.Worksheets(1)
        objSht.NAME = "Exported Data"
        With objSht
            .Range(.Cells(StartRow, 2), .Cells(StartRow + MaxRow, 2)) _
                    .CopyFromRecordset rst                  
        End With
    End With

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing


Set rst = Nothing

Exit_cmdExcel_Click:
    Exit Sub

Err_cmdExcel_Click:
    MsgBox Err.Description
    Resume Exit_cmdExcel_Click
End Sub

Open in new window

Give it a spin
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mbizupCommented:
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

0
lrollinsIT ManagerAuthor Commented:
Thanks John.  That worked great!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Databases

From novice to tech pro — start learning today.