Export Query to XLS with added Where Statement

[vapid2323]

Hey guys,

I will start off by saying http://www.access-programmers.co.uk/forums/showthread.php?t=208324 is very close to what I need.

I have a form in my Access 2007 DB that manages filtering all my reports with VBA, as in creates a WHERE statment that I can filter the output with.

Now everything is working great but I am a bit lost how I might be able to filter a query with the same sort of setup. Is it possible to grab a queries SQL and append the WHERE statment then run and export it?

The link above is great but I dont want to hard code all my queries into VBA if possible.

Thanks, Let me know if you need more info!

 

[boblarson]

How about not using the method shown in that link and, instead, take the code from my website here:
http://www.btabdevelopment.com/ts/default.aspx?PageId=47
And paste it into a standard module and it will send the filtered form's recordset to Excel - easily.

 

[vapid2323]

How about not using the method shown in that link and, instead, take the code from my website here:
http://www.btabdevelopment.com/ts/default.aspx?PageId=47
And paste it into a standard module and it will send the filtered form's recordset to Excel - easily.

Thanks for this but I am not sure it will work for my needs as the form I have open is unbound, it creates the where statement with the following code... well there is a bit more but this is a good chunk, also I did not create this code.

So it’s only applying a filter to already created Reports, now I want to see if I can do something similar with a query instead.

Private Function GetWhereClause() As String
On Error Resume Next

    Dim dbs As DAO.Database
    Dim sSQL As String
    Dim ctl As control
    
    Dim sCtlList As String
    Dim aCtlLst() As String
    Dim iCurr As Integer
    Dim sWhere As String
    Dim sValLst As String
    Dim sCtlName As String
    Dim sCtlName2 As String
    Dim sFieldName As String
    Dim sCommonName As String
    Dim sType As String
    Dim sValue As String
    Dim varValue As Variant
    Dim dDateStart As Date
    Dim dDateEnd As Date
    
    Dim fCtlExists As Boolean
    Dim fCtlVisible As Boolean
    Dim fCtlEnabled As Boolean
    
    Set dbs = CurrentDb
    sSQL = "DELETE * FROM zwtblWHERE"
    dbs.Execute sSQL
    
    ' initialize where String
    sWhere = " 1=1 " & vbCrLf

    sCtlList = Me.lstReports.Column(3)
    If Right(sCtlList, 1) <> "," Then sCtlList = sCtlList & ","
    aCtlLst = Split(sCtlList, ",")
    
    
    ' Loop through the list of controls
    For iCurr = 0 To UBound(aCtlLst)
        ' For each new control name, reset variables
        sValue = ""
        varValue = Null
        fCtlExists = False
        fCtlEnabled = False
        fCtlVisible = False
        
        sCtlName = aCtlLst(iCurr)
        sType = Left(sCtlName, 3)
        
        ' Error Handling is set to RESUME NEXT because our list might
        ' contain names of controls that don't exist on this form.  It
        ' is a list of "potential" controls.  If the control doesn't
        ' exist, an error will be generated here.
        Err.Clear
        Set ctl = Me.Controls(sCtlName)
        
        ' Use the error (or lack thereof) to decide if the control exists
        fCtlExists = (Err.Number = 0)
        Err.Clear
        
        If fCtlExists Then
            fCtlEnabled = (ctl.enabled = True)
            fCtlVisible = (ctl.visible = True)
        End If
        
        ' Now, process controls that exist, and are Visible & Enabled.
        If fCtlExists And fCtlVisible And fCtlEnabled Then
            ' Retrieve the table field name corresponding to the control
            sFieldName = GetFieldNameFromControlName(sCtlName)
            sCommonName = GetCommonNameFromControlName(sCtlName)
            sSQL = " INSERT INTO zwtblWHERE (FieldName, FieldAlias, FieldType, Delimiter, Operator, ValueList)" & _
                   " VALUES('" & sFieldName & "','" & sCommonName & "',"
            
            Select Case sType
                ' txt controls can contain any type of text  (delimited with single quotes)
                Case "txt"
                    sValue = Nz(ctl.Value, "")
                    If sValue <> "" Then
                        sValue = Replace(sValue, "'", "''")
                        sWhere = sWhere & " AND ([" & sFieldName & "] = '" & sValue & "') " & vbCrLf
                        dbs.Execute sSQL & "'Text'," & q & "'" & q & ",'='," & q & "'*" & sValue & "*'" & q & ")"
                    End If
                
                ' lke controls contain text to compare with LIKE operator (*).
                Case "lke"
                    sValue = Nz(ctl.Value, "")
                    If sValue <> "" Then
                        sValue = Replace(sValue, "'", "''")
                        sWhere = sWhere & " AND ([" & sFieldName & "] LIKE '*" & sValue & "*') " & vbCrLf
                        dbs.Execute sSQL & "'Text'," & q & "'" & q & ",'LIKE'," & q & "'*" & sValue & "*'" & q & ")"
                    End If
                    
                ' num controls can only contain numeric data.
                Case "num"
                    sValue = Nz(ctl.Value, "")
                    If sValue <> "" And IsNumeric(sValue) = True Then
                        sWhere = sWhere & " AND ([" & sFieldName & "] = " & sValue & ") " & vbCrLf
                        dbs.Execute sSQL & "'Numeric','','=','" & sValue & "')"
                    End If
                    
                ' dte controls may contain only date RANGES.
                Case "dte"
                    ' There should always be a pair of date controls.  One with
                    ' the START value and one with END.  Process only START control.
                    If InStr(1, sCtlName, "Start") > 0 Then
                        varValue = Me.Controls(sCtlName)
                        
                        ' Must use valid dates. Continue only if START date is valid.
                        If IsDate(varValue) Then
                            dDateStart = CDate(varValue)
                            sCtlName2 = Replace(sCtlName, "Start", "End")
                            varValue = Me.Controls(sCtlName2)
                            
                            ' Again, we can only continue if END date is valid
                            If IsDate(varValue) Then
                                dDateEnd = CDate(varValue)
                                sWhere = sWhere & " AND ([" & sFieldName & "] BETWEEN #" & dDateStart & "# AND #" & dDateEnd & "#) " & vbCrLf
                                dbs.Execute sSQL & "'Date','#','BETWEEN','" & Format(dDateStart, "mmm-dd-yyyy") & "  AND  " & Format(dDateEnd, "mmm-dd-yyyy") & "')"
                            End If
                        End If
                    End If
                    
                ' lst controls are multi-select list boxes and use the IN operator
                Case "lst"
                    '  (If <All> is selected (first item), then skip this part of WHERE clause.
                    If ctl.Selected(0) = False Then
                        sValue = GetSelectedItems(ctl)
                        sWhere = sWhere & " AND ([" & sFieldName & "] IN " & sValue & ") " & vbCrLf
                        dbs.Execute sSQL & "'Text'," & q & "'" & q & ",'IN LIST:'," & q & sValue & q & ")"
                    End If
                    
                ' cbo controls are single item combo boxes and return single value.
                Case "cbo"
                    sValue = Nz(ctl.Value, "")
                    If sValue <> "" Then
                        sValue = Replace(sValue, "'", "''")
                        '  (If <All> is selected, then skip this part of WHERE clause.
                        If Left(sValue, 4) <> "<All" Then
                            sWhere = sWhere & " AND ([" & sFieldName & "] = '" & sValue & "') " & vbCrLf
                            dbs.Execute sSQL & "'Text'," & q & "'" & q & ",'IS','" & sValue & "')"
                        End If
                    End If
            End Select
        End If
        
        ' Because we have the error handler set to resume next, we must
        ' reset the control variable to NOTHING to avoid strange results
        Set ctl = Nothing
    Next
    
    Set dbs = Nothing
    GetWhereClause = sWhere

End Function

 

[boblarson]

Thanks for this but I am not sure it will work for my needs as the form I have open is unbound, ...

You are correct, it won't work for you.

... it creates the where statement with the following code... well there is a bit more but this is a good chunk, also I did not create this code.

So it’s only applying a filter to already created Reports, now I want to see if I can do something similar with a query instead.

Not sure how your filter is actually working. The code shown is kind of confusing without being able to see all of the applicable parts (the tables, reports, etc.).

 

[vapid2323]

You are correct, it won't work for you.



Not sure how your filter is actually working. The code shown is kind of confusing without being able to see all of the applicable parts (the tables, reports, etc.).

Just got back to this,

I guess to simplify this, I need to take and modify SQL statements from queries that have already been created. To give you a visual I have attached a screenshot of my form that filters the data.

At the left we have a list of both queries and reports, normally a user will select a report and then the related options will be unlocked on the right. They can then export the report and see the filtered data.

This works great with reports as you can add in a where statement when you open them. But I want to do the same with a query.

So I want to create temporary queries based off old ones...

 

[boblarson]

You can use a querydef object to change the where clause on a query.

First off, to make it easy, download this code here (provided for free from Access MVP Armen Stein). Just unzip, open the text file and copy it and paste into a new standard module.:
http://www.jstreettech.com/files/basJStreetSQLTools.zip

Then the code will be something like this:

Function ExportQuery(strQueryName As String)
    Dim qdf As DAO.QueryDef
    Dim strSQL As String
    Dim strWHERE As String

    strWHERE = Nz(DLookup("FieldWithWhereClause", "YourWhereClauseTable"), vbNullString)

    Set qdf = CurrentDb.QueryDefs(strQueryName)
    strSQL = qdf.SQL

    qdf.SQL = ReplaceWhereClause(strSQL, strWHERE)

    SendTQ2Excel qdf.Name
    qdf.SQL = strSQL
    qdf.Close

    Set qdf = Nothing

End Function

And inside that code you will see I actually used my code from my website too - the SendTQ2Excel function.

 

[vapid2323]

You can use a querydef object to change the where clause on a query.

First off, to make it easy, download this code here (provided for free from Access MVP Armen Stein). Just unzip, open the text file and copy it and paste into a new standard module.:
http://www.jstreettech.com/files/basJStreetSQLTools.zip

Then the code will be something like this:

Function ExportQuery(strQueryName As String)
    Dim qdf As DAO.QueryDef
    Dim strSQL As String
    Dim strWHERE As String

    strWHERE = Nz(DLookup("FieldWithWhereClause", "YourWhereClauseTable"), vbNullString)

    Set qdf = CurrentDb.QueryDefs(strQueryName)
    strSQL = qdf.SQL

    qdf.SQL = ReplaceWhereClause(strSQL, strWHERE)

    SendTQ2Excel qdf.Name
    qdf.SQL = strSQL
    qdf.Close

    Set qdf = Nothing

End Function

And inside that code you will see I actually used my code from my website too - the SendTQ2Excel function.

NICE! I think this will work, I will try it out later this week when I have some time. Thanks for your help!