{"id":738,"date":"2015-12-27T23:49:34","date_gmt":"2015-12-28T04:49:34","guid":{"rendered":"http:\/\/regina-whipp.com\/blog\/?p=738"},"modified":"2016-01-01T19:46:29","modified_gmt":"2016-01-02T00:46:29","slug":"send-to-excel","status":"publish","type":"post","link":"https:\/\/regina-whipp.com\/blog\/?p=738","title":{"rendered":"Export a Parameter Query to Excel…"},"content":{"rendered":"

It\u2019s always tricky when you want export filtered data to Excel.\u00a0 You will get an error message if you put try to put the Forms Control in the Criteria section of the Query.\u00a0 Why?\u00a0 Because Access insists on having the value before it can execute the export and not from the Form but directly in its SQL.\u00a0 So, we will create the Query *on the fly*, export and then delete it, after all, no need to keep it as it will be recreated with new parameters for the next export.\u00a0 Let\u2019s get started\u2026<\/p>\n

Create your Template (Line 17) and make note of which row you want your Recordset (data) to start on (Line 30), as well as, cells that you want to populate in the header part of your spreadsheet, such as, the date (Line 26).\u00a0 Then you will need the path of your Template and the path and naming convention of the saved worksheet (Line 43).<\/p>\n

Copy\/paste the Function SendToExcel<\/strong> into a Module\u2026 that said I usually put it behind the Filter Form because I am using a Template specific to a Recordset and I can use the same name for the Function and when I put the button on the Form I can keep that code the same, which a few minor changes.<\/p>\n

\r\nFunction SendToExcel(strTQName As String, strSheetName As String)\r\n'Modified from http:\/\/btabdevelopment.com\/export-a-table-or-query-to-excel-to-specific-worksheet\/\r\n' strTQName is the name of the table or query you want to send to Excel\r\n' strSheetName is the name of the sheet you want to send it to\r\n\r\n        Dim rst As DAO.Recordset\r\n        Dim ApXL As Object\r\n        Dim xlWBk As Object\r\n        Dim xlWSh As Object\r\n        Dim fld As DAO.Field\r\n        Dim lngMaxRow As Long\r\n        Dim lngMaxCol As Long\r\n        Dim strPath As String\r\n\r\n        On Error GoTo Err_Handler\r\n            'Full Path and Name of Template\r\n            strPath = "Full Path and Name of Template"\r\n\r\n            Set rst = CurrentDb.OpenRecordset(strTQName)\r\n            Set ApXL = CreateObject("Excel.Application")\r\n\r\n            Set xlWBk = ApXL.Workbooks.Open(strPath)\r\n            ApXL.Visible = True\r\n\r\n            'Set xlWSh = xlWBk.Worksheets(strSheetName)\r\n            'xlWSh.Range("A1").Value = Date\r\n\r\n            rst.MoveFirst\r\n           'The first row that you want your data to appear on\r\n            xlWSh.Range("A5").CopyFromRecordset rst\r\n            'Selects the first cell to unselect all cells\r\n            xlWSh.Range("A5").Select\r\n        'To apply Filters and to automatically resize the columns\r\n        xlWSh.Activate\r\n        xlWSh.Cells.Rows(4).AutoFilter\r\n        xlWSh.Cells.Rows(4).EntireColumn.AutoFit\r\n\r\n        rst.Close\r\n        Set rst = Nothing\r\n        'Remove prompts to save the Spreadsheet\r\n        ApXL.DisplayAlerts = False\r\n        'You will want to rename the Template so as to not overwrite it\r\n        xlWBk.SaveAs "Full Path and Name of NEW Workbook", 51\r\n        ApXL.DisplayAlerts = True\r\n        'ApXL.Quit\r\n\r\n        Exit Function\r\nErr_Handler:\r\n        DoCmd.SetWarnings True\r\n        MsgBox Err.Description, vbExclamation, Err.Number\r\n        Exit Function\r\n\r\nEnd Function\r\n<\/pre>\n
Put a Command Button on your Form.\u00a0 Now, we need to determine what type of Query you have, is it…<\/p>\n
Straight SQL
\n<\/strong><\/p>\n
\r\nstrSQL = "SELECT... " & _\r\n         "FROM..."\r\n<\/pre>\n
SQL with a Group By\u00a0<\/strong><\/p>\n
\r\nstrSQL = "SELECT... " & _\r\n         "FROM... " & _\r\n         "GROUP BY..."\r\n<\/pre>\n
SQL with Criteria (WHERE) separate from what will be selected on the Form<\/strong><\/p>\n
\r\nstrSQL = "SELECT... " & _\r\n         "FROM... " & _\r\n         "WHERE... " & _\r\n         "ORDER BY..."\r\n<\/pre>\n
Not sure?\u00a0 Go to Design View of the Query and then select SQL View (upper left hand corner).\u00a0 Once you got which one scroll down to the appropriate section.<\/p>\n
Then\u00a0copy\/paste the below between the Private Sub<\/strong> and End Sub<\/strong>.\u00a0 You will need to modify the filtering portion to match the name of the Controls and your Recordsource accordingly.\u00a0 Once done you can begin testing and adjusting.<\/p>\n
Straight SQL<\/strong><\/p>\n
\r\n'Code from Allen Browne\u2019s site (http:\/\/allenbrowne.com\/ser-62code.html) modified\r\n\r\n        Dim dbs As DAO.Database\r\n        Dim qryDef As DAO.QueryDef\r\n        Dim strSQL As String\r\n        Dim strWhere As String\r\n        Dim lngLen As Long\r\n        Dim lngWhere As String\r\n\r\n        Set dbs = CurrentDb\r\n\r\n    'Put the SQL portion only of your Query here.\r\n    strSQL = "SELECT\u2026\u201d\r\n\r\n    'Text field example. Use quotes around the value in the string.\r\n    If Not IsNull(Me.txtFilterCity) Then\r\n        strWhere = strWhere & "([City] = """ & Me.txtFilterCity & """) AND "\r\n    End If\r\n\r\n    'Another text field example. Use Like to find anywhere in the field.\r\n    If Not IsNull(Me.txtFilterMainName) Then\r\n        strWhere = strWhere & "([MainName] Like ""*" & Me.txtFilterMainName & "*"") AND "\r\n    End If\r\n\r\n    'Number field example. Do not add the extra quotes.\r\n    If Not IsNull(Me.cboFilterLevel) Then\r\n        strWhere = strWhere & "([LevelID] = " & Me.cboFilterLevel & ") AND "\r\n    End If\r\n\r\n    'Yes\/No field and combo example. If combo is blank or contains "ALL", we do nothing.\r\n    If Me.cboFilterIsCorporate = True Then\r\n        strWhere = strWhere & "([IsCorporate] = True) AND "\r\n    ElseIf Me.cboFilterIsCorporate = 0 Then\r\n        strWhere = strWhere & "([IsCorporate] = False) AND "\r\n    End If\r\n\r\n    'Date field example. Use the format string to add the # delimiters and get the right international format.\r\n    If Not IsNull(Me.txtStartDate) Then\r\n        strWhere = strWhere & "([EnteredOn] >= " & Format(Me.txtStartDate, conJetDate) & ") AND "\r\n    End If\r\n\r\n    'Another date field example. Use "less than the next day" since this field has times as well as dates.\r\n    If Not IsNull(Me.txtEndDate) Then   'Less than the next day.\r\n        strWhere = strWhere & "([EnteredOn] < " & Format(Me.txtEndDate + 1, conJetDate) & ") AND "\r\n    End If\r\n\r\n'I added an example for multi-select List Boxes\r\n        If Me.lstRoleID.ItemsSelected.Count <> 0 Then\r\n            'add selected values to string\r\n            Set ctl = Me.lstRoleID\r\n            For Each varItem In ctl.ItemsSelected\r\n              'strWhere = strWhere & ctl.ItemData(varItem) & ","\r\n              'Use this line if your value is text\r\n              lngWhere = lngWhere & "'" & ctl.ItemData(varItem) & "',"\r\n            Next varItem\r\n            'trim trailing comma\r\n            lngWhere = Left(lngWhere, Len(lngWhere) - 1)\r\n            strWhere = strWhere & "stSourceType IN(" & lngWhere & ") AND "\r\n        End If\r\n\r\n    lngLen = Len(strWhere) - 5\r\n\r\n    If lngLen <= 0 Then\r\n        'If no selection is made then send everything to Excel\r\n        strSQL = strSQL\r\n        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)\r\n        'DoCmd.OpenQuery qryDef.Name\r\n        qryDef.Close\r\n        Set qryDef = Nothing\r\n        DoEvents\r\n        Call SendToExcel("qrySendToExcel", "Sheet1")\r\n        DoEvents\r\n        DoCmd.DeleteObject acQuery, "qrySendToExcel"\r\n    Else\r\n        'Send filtered results to Excel\r\n        strWhere = Left$(strWhere, lngLen)\r\n        strSQL = strSQL & " WHERE " & strWhere\r\n        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)\r\n        'DoCmd.OpenQuery qryDef.Name\r\n        qryDef.Close\r\n        Set qryDef = Nothing\r\n        DoEvents\r\n        Call SendToExcel("qrySendToExcel", "Sheet1")\r\n        DoEvents\r\n        DoCmd.DeleteObject acQuery, "qrySendToExcel"\r\n    End If\r\n\r\n        dbs.Close\r\n        Set dbs = Nothing\r\n<\/pre>\n
SQL with a Group By\u00a0 <\/strong>*You will need to add the filtering from Straight SQL<\/p>\n
\r\n        Dim dbs As DAO.Database\r\n        Dim qryDef As DAO.QueryDef\r\n        Dim strSQL As String\r\n        Dim strWhere As String\r\n        Dim strOrderBy As String\r\n        Dim lngLen As Long\r\n        Dim lngWhere As String\r\n\r\n        Set dbs = CurrentDb\r\n\r\n    'Put the SQL portion only of your Query here.\r\n    strSQL = "SELECT\u2026\u201d\r\n\r\n    strOrderBy = " ORDER BY quniMIForExcel.mySequence"\r\n\r\n'ADD FILTERING FROM Straight SQL and adjust\r\n\r\n    lngLen = Len(strWhere) - 5\r\n\r\n    If lngLen <= 0 Then\r\n        'If no selection is made then send everything to Excel\r\n        strSQL = strSQL & strOrderBy\r\n        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)\r\n        'DoCmd.OpenQuery qryDef.Name\r\n        qryDef.Close\r\n        Set qryDef = Nothing\r\n        DoEvents\r\n        Call SendToExcel("qrySendToExcel", "Sheet1")\r\n        DoEvents\r\n        DoCmd.DeleteObject acQuery, "qrySendToExcel"\r\n    Else\r\n        'Send filtered results to Excel\r\n        strWhere = Left$(strWhere, lngLen)\r\n        strSQL = strSQL & " WHERE " & strWhere & strOrderBy\r\n        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)\r\n        'DoCmd.OpenQuery qryDef.Name\r\n        qryDef.Close\r\n        Set qryDef = Nothing\r\n        DoEvents\r\n        Call SendToExcel("qrySendToExcel ", "Sheet1")\r\n        DoEvents\r\n        DoCmd.DeleteObject acQuery, "qrySendToExcel"\r\n    End If\r\n\r\n        dbs.Close\r\n        Set dbs = Nothing\r\n<\/pre>\n
SQL with Criteria separate from what will be selected on the Form\u00a0 <\/strong>*You will need to add the filtering from Straight SQL<\/p>\n
\r\n        Dim dbs As DAO.Database\r\n        Dim qryDef As DAO.QueryDef\r\n        Dim strSQL As String\r\n        Dim strWhere As String\r\n        Dim strQueryWhere As String\r\n        Dim strOrderBy As String\r\n        Dim lngLen As Long\r\n        Dim lngWhere As String\r\n\r\n        Set dbs = CurrentDb\r\n\r\n    'Put the SQL portion only of your Query here.\r\n    strSQL = "SELECT\u2026\u201d\r\n\r\n    strOrderBy = " ORDER BY quniMIForExcel.mySequence"\r\n    strQueryWhere = "(((tblLifts.lStatusID)=1 Or (tblLifts.lStatusID)=0) AND ((tblLifts.lTransferTo) Is Null) AND ((tblCoilRun.crNoShow)=False))"\r\n\r\n'ADD FILTERING FROM Straight SQL and adjust\r\n\r\n    lngLen = Len(strWhere) - 5\r\n\r\n    If lngLen <= 0 Then\r\n        'If no selection is made then send everything to Excel\r\n        strSQL = strSQL & " WHERE " & strQueryWhere & strOrderBy\r\n        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)\r\n        'DoCmd.OpenQuery qryDef.Name\r\n        qryDef.Close\r\n        Set qryDef = Nothing\r\n        DoEvents\r\n        Call SendToExcel("qrySendToExcel", "Sheet1")\r\n        DoEvents\r\n        DoCmd.DeleteObject acQuery, "qrySendToExcel"\r\n    Else\r\n        'Send filtered results to Excel\r\n        strWhere = Left$(strWhere, lngLen)\r\n        strSQL = strSQL & " WHERE " & strQueryWhere & " AND " & strWhere & strOrderBy\r\n        Set qryDef = dbs.CreateQueryDef("qrySendToExcel", strSQL)\r\n        'DoCmd.OpenQuery qryDef.Name\r\n        qryDef.Close\r\n        Set qryDef = Nothing\r\n        DoEvents\r\n        Call SendToExcel("qrySendToExcel", "Sheet1")\r\n        DoEvents\r\n        DoCmd.DeleteObject acQuery, "qrySendToExcel"\r\n    End If\r\n\r\n        dbs.Close\r\n        Set dbs = Nothing\r\n<\/pre>\n
Don’t forget to add error code!<\/p>\n
<\/div>\n
<\/path><\/svg><\/i> \"Loading\"<\/p>\n
<\/div>\n","protected":false},"excerpt":{"rendered":"
It\u2019s always tricky when you want export filtered data to Excel. You will get an error message if you put try to put the Forms Control in the Criteria section of the Query. Why? Because Access insists on having the value before it can execute the export and not from the Form but directly in […]<\/p>\n
<\/div>\n
<\/path><\/svg><\/i> \"Loading\"<\/p>\n
<\/div>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[5,63],"tags":[34,38,22,30,21],"class_list":["post-738","post","type-post","status-publish","format-standard","hentry","category-access-tips","category-database-design","tag-excel","tag-export","tag-queries","tag-reports","tag-vba","odd"],"_links":{"self":[{"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/738","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=738"}],"version-history":[{"count":15,"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/738\/revisions"}],"predecessor-version":[{"id":1179,"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/738\/revisions\/1179"}],"wp:attachment":[{"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=738"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=738"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/regina-whipp.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=738"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}