[AccessD] Access 2007 - Exporting Report (with Dynamic Filters) to Excel

Hi Brad:

I use this technique all the time.  Here is the unexpurgated code for the
proc I use; it creates a dummy query and builds the SQL up from the original
query and the 'Where' string that is passed to it.  I've included the option
to save it to the user's desktop or not.  Let me know if you have any
questions.

Doug

Public Sub ExportQueryToExcel(QueryName As String, Optional WhereString,
Optional toDeskTop As Boolean = True)
  'note:  the sql string in a query appears to be terminated with a ; then a
space then a c/r
  Dim qName As String, fname As String
  Dim qd As QueryDef
  Dim sqlStr As String
  Dim OrdBy As Integer
  Dim Where As Integer
  Dim MyWhereString As String
  Dim MyOrderByString As String
  Dim myPath As String

  'add general query front end to sqlstring
  Set qd = CurrentDb.QueryDefs(QueryName)
  sqlStr = qd.SQL

  If Not IsMissing(WhereString) Then
    If WhereString <> "" Then 'need to add this where string to existing if
any
    'parse off existing order by/group by (for summary queries) and where
      OrdBy = InStr(sqlStr, "ORDER BY")
      If OrdBy = 0 Then OrdBy = InStr(sqlStr, "GROUP BY")
      If OrdBy <> 0 Then
        MyOrderByString = Right(sqlStr, Len(sqlStr) - OrdBy + 1) 'includes
trailing ;
        sqlStr = Left(sqlStr, OrdBy - 1)
      End If
      Where = InStr(sqlStr, "WHERE")
      If Where = 0 Then
        If OrdBy = 0 Then
          sqlStr = Left(sqlStr, Len(sqlStr) - 3) & " WHERE " & WhereString &
";"
         Else
          sqlStr = sqlStr & " WHERE " & WhereString & " " & MyOrderByString
        End If
       Else
        If OrdBy = 0 Then
          sqlStr = Left(sqlStr, Len(sqlStr) - 3) & " AND (" & WhereString &
" );"
         Else
          sqlStr = sqlStr & " AND (" & WhereString & " ) " & MyOrderByString
        End If
      End If
    End If
  End If

  On Error Resume Next
  CurrentDb.QueryDefs.Delete ("zqTempQueryForExcelExport")
  On Error GoTo 0

  Set qd = CurrentDb.CreateQueryDef("zqTempQueryForExcelExport", sqlStr)

  myPath = ""
  If toDeskTop Then myPath = getDesktopPath
  If myPath = "" Then
    myPath = GetPathFromName(CurrentDb.Name)
  End If


    fname = adhCommonFileOpenSave(, "Excel files|*.xls", , , QueryName &
Format(Date, "_mm_dd_yy"), , myPath, , False)
    If fname = "" Then
      MsgBox "No file selected - please try again!"
      Exit Sub
    End If
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"zqTempQueryForExcelExport", fname

End Sub

Function getDesktopPath() As String
 ' Options For special folders
 '    AllUsersDesktop
 '    AllUsersStartMenu
 '    AllUsersPrograms
 '    AllUsersStartup
 '    Desktop
 '    Favorites
 '    Fonts
 '    MyDocuments
 '    NetHood
 '    PrintHood
 '    Programs
 '    Recent
 '    SendTo
 '    StartMenu
 '    Startup
 '    Templates

    Dim objWSHShell As Object
    Dim strSpecialFolderPath

    getDesktopPath = ""

    On Error GoTo ErrorHandler
     ' Create a shell object
    Set objWSHShell = CreateObject("WScript.Shell")
     '  Find out the path to the passed special folder,
     '  just change the "Desktop" for one of the other options
    getDesktopPath = objWSHShell.SpecialFolders("Desktop")
     ' Clean up
    Set objWSHShell = Nothing

ErrorHandler:

'     MsgBox "Error finding " & strSpecialFolder, vbCritical + vbOKOnly,
"Error"

End Function

On Thu, Jul 15, 2010 at 3:15 PM, Brad Marks <brad.marks1 at gmail.com> wrote:

> We have an Access 2007 report that has "dynamic filters" which enable the
> end-users to trim down the amount of data on the report.  This is done with
> code like this...
>
>