Programatically Changing Query Criteria

  • Thread starter Thread starter Allan Koodray
  • Start date Start date
A

Allan Koodray

I have a Queries designed to spool a text file for
Budgets for each of a five year business plan (5 queries
in all).

I was wondering if there was a way I could
programatically change the query criteria (using VBA) to
use a single query to create each of the five files.

Where I am having problems is how to change the criteria
name. What is the VBA code to change the criteria
parameter within the query? From there I should be able
to create a do while loop accessing values in a table
(what command would be used to retrive those values as
well?).

Allan
 
Allan,

Save your query in SQL. Then in VBA use a variation of
the following to determine your criteria. This is one I
have that is tested and works.

**********************************************
Private Sub cmdFindMatches_Click()

Dim strSQL As String

If Not EntriesValid Then Exit Sub

If Not BuildSQLString(strSQL) Then
MsgBox "There was a problem building the SQL String"
Exit Sub
End If

If Not chkAwdLog Then CurrentDb.QueryDefs
("qryAwdReport").SQL = strSQL

If Not DisplayResults Then
MsgBox "There was a problem diplaying the report."
Exit Sub
End If

End Sub
____________________________________________________
Function EntriesValid() As Boolean

Dim strMsg As String
Dim strBullet As String

strBullet = "o"

If chkSSN And IsNull(cmbSSN) Then
strMsg = strMsg & vbCrLf & vbCrLf & strBullet & " You
have chosen to filter by SSN but have not chosen an SSN."
& _
"Please either select an SSN or uncheck the ""SSN""
checkbox."
End If

If chkAwardType And IsNull(cmbAwardType) Then
strMsg = strMsg & vbCrLf & vbCrLf & strBullet & " You
have chosen to filter by Award Type but have not chosen an
Award Type." & _
"Please either select an Award Type or uncheck
the ""Type of Award"" checkbox."
End If

If chkDateReceived And IsNull(cmbTimeConstant) Then
strMsg = strMsg & vbCrLf & vbCrLf & strBullet & " You
have chosen to filter by received date but have not chosen
a comparison constant." & _
"Please either select a comparitor or uncheck
the ""Received"" checkbox."
End If

If strMsg <> "" Then
MsgBox "The following errors are preventing you from "
& _
"viewing the records that match the criteria "
& _
"you have selected:" & strMsg & vbCrLf & vbCrLf
& _
"Please correct these errors and try again.", _
vbExclamation + vbOKOnly, Application.Name
Else
EntriesValid = True
End If

Debug.Print EntriesValid

End Function

________________________________________________________
Function BuildSQLString(strSQL As String) As Boolean

Dim sSelect As String
Dim sFrom As String
Dim sWhere As String
Dim iCounter As Integer

sSelect = "SELECT tblAwards.SSN, tblAwards.[Award Type],
tblAwards.[OLC#], tblAwards.[Award Reason]," & _
"tblAwards.[Presentation Date], tblAwards.[Received Date],
tblAwards.[Recieved By], tblAwards.[Internal Remarks]," & _
"tblAwards.[Fwd Date], tblAwards.[FedEx Tracking Number],
tblAwards.[Div Remarks], tblAwards.[Completion Date]," & _
"tblAwards.[Order Number]"

sFrom = "FROM tblAwards"

If chkAwdLog Then
BuildSQLString = True
Exit Function
End If

If chkSSN Then
sWhere = sWhere & "((tblAwards.SSN)= """ & cmbSSN
& """)"
iCounter = iCounter + 1
End If

If chkAwardType Then
If cmbAwardType.Value = "Other" Then
If iCounter > 0 Then
sWhere = sWhere & " AND (((tblAwards.[Award Type])
Not In (""LOM"",""MSM"",""ARCOM"",""AAM"",""MOVSM"")))"
Else
sWhere = sWhere & "(((tblAwards.[Award Type]) Not In
(""LOM"",""MSM"",""ARCOM"",""AAM"",""MOVSM"")))"
iCounter = iCounter + 1
End If
End If
Else
If iCounter > 0 Then
sWhere = sWhere & " AND ((tblAwards.[Award Type])
= """ & cmbAwardType & """)"
Else
sWhere = sWhere & "((tblAwards.[Award Type])= """ &
cmbAwardType & """)"
iCounter = iCounter + 1
End If
End If

If chkDateReceived Then

If cmbTimeConstant.Value = "Before" Then
If iCounter > 0 Then
sWhere = sWhere & " AND ((tblAwards.[Received
Date])<=#" & txtDateto & "#)"
Else
sWhere = sWhere & "((tblAwards.[Received Date])
<=#" & txtDateto & "#)"
End If
End If

If cmbTimeConstant.Value = "Between" Then
If iCounter > 0 Then
sWhere = sWhere & " AND ((tblAwards.[received
date]) Between #" & txtDateFrom & "# and #" & txtDateto
& "#)"
Else
sWhere = sWhere & "((tblAwards.[received date])
Between #" & txtDateFrom & "# and #" & txtDateto & "#)"
End If
End If

If cmbTimeConstant.Value = "After" Then
If iCounter > 0 Then
sWhere = sWhere & " AND ((tblAwards.[Received
Date])>= #" & txtDateFrom & "#)"
Else
sWhere = sWhere & "((tblAwards.[Received Date])>=
#" & txtDateFrom & "#)"
End If
End If

iCounter = iCounter + 1

End If

If iCounter > 0 Then
strSQL = sSelect & " " & sFrom & " " & "WHERE (" &
sWhere & ");"
Else
strSQL = sSelect & " " & sFrom & ";"
End If

Debug.Print strSQL

BuildSQLString = True
Debug.Print BuildSQLString

End Function

________________________________________________
Function DisplayResults() As Boolean

Dim iReturn As Integer
Dim iRtn As Integer

If chkAwdLog Then
DoCmd.OpenReport "rptAwdLog", acViewPreview
iReturn = MsgBox("Would you like to print a copy as
well?", vbYesNo + vbQuestion + vbDefaultButton2, "Print
Report?")

If iReturn = vbYes Then
DoCmd.OpenReport "rptAwdLog", acViewNormal
End If
DoCmd.Close acForm, "frmAwardRpt"
DisplayResults = True
Exit Function
End If

iReturn = MsgBox("Would you like to view your results?",
vbYesNoCancel + vbDefaultButton1 + vbQuestion, "View
Report")

If iReturn = vbCancel Then
DoCmd.Close acForm, "frmAwardRpt"
ElseIf iReturn = vbNo Then
iRtn = MsgBox("Would you like to print the report?",
vbYesNo + vbQuestion + vbDefaultButton1, "Print Report")

If iRtn = vbNo Then
DoCmd.Close acForm, "FrmAwardRpt"
Else
DoCmd.OpenReport "rptAwdReport", acViewNormal
DoCmd.Close acForm, "frmAwardRpt"
End If
Else
DoCmd.OpenReport "rptAwdReport", acViewPreview
DoCmd.Close acForm, "frmAwardRpt"
End If

DisplayResults = True
Debug.Print DisplayResults

End Function

******************************************

Basically, this rewrites the SQL statement and then resets
the query to utilize that SQL string. Your's probably
will not be quite this complicated, but this should still
get you on the right path.

HTH

AJ
 
Back
Top