Search button using more than one text field Access vba - sql

This is my code below. I am trying to search a database using two different dates, company name
I am getting an error when one of the date fields is empty or null. How can I solve this issue or bypass if the date search field is empty to ignore it in the search or search for an empty field?
Dim SQL As String
SQL = "SELECT * from qryRequestInternal where ([DateRequestSent] = #" & txt_Search_Sdate & "# AND [DateReceived] = #" & txt_Search_Rdate & "# AND (companyName like ""*" & txt_SCompNa & "*"") )"
Me.sfrmRequestInternal.Form.RecordSource = SQL
Me.sfrmRequestInternal.Form.Requery
Me.sfrmRequestInternal_col.Form.RecordSource = SQL
Me.sfrmRequestInternal_col.Form.Requery
End Sub

You will need to check for Null values and build the SQL string based on the controls which have a value (i.e. not null).
The example below uses a helper function to build the sql string. If nothing is inserted, it will only run the the Select * from qryRequestInternal without any criteria.
Private Function SqlWhere() As String
Dim retvalue As String
'sent date
With txt_Search_Sdate
If Not IsNull(.Value) Then
retvalue = " WHERE [DateRequestSent] = #" & Format(.Value, "mm/dd/yyyy") & "#"
End If
End With
'received date
With txt_Search_Rdate
If Not IsNull(.Value) Then
retvalue = IIf(Len(retvalue) = 0, " WHERE", retvalue & " AND") & " [DateReceived] = #" & Format(.Value, "mm/dd/yyyy") & "#"
End If
End With
'company
With txt_SCompNa
If Not IsNull(.Value) Then
retvalue = IIf(Len(retvalue) = 0, " WHERE", retvalue & " AND") & " [companyName] Like '*" & .Value & "*'"
End If
End With
SqlWhere = retvalue
End Function
To call it:
Dim sqlString As String
sqlString = "SELECT * from qryRequestInternal" & SqlWhere()
Debug.Print sqlString

Related

How can I resolve runtime error 3075 in VBA

I have problem running this code. It gives me Syntax error (missing operator) in query expression
Function SearchCriteria()
Dim class,StateProvince,strAcademicYear As As String
Dim task, strCriteria As String
If isNull(Forms!frmStudentList!cboClass) Then
Class = "[Class] LIKE '*' "
Else
Class = [Class] = " & Forms!frmStudentList!cboClass
End If
If isNull(Forms!frmStudentList!cboStateProvince) Then
StateProvince = "[StateProvince] LIKE '*' "
Else
StateProvince = [StateProvince] = " &
Forms!frmStudentList!cboStateProvince
End If
If isNull(Forms!frmStudentList!cboAcademicYear) Then
StrAcademicYear = "[AcademicYear] LIKE '*' "
Else
StrAcademicYear = [AcademicYear] = '" &
Forms!frmStudentList!cboAcademicYear & "'"
End If
strCriteria = Class & "AND" & StateProvince & "AND" & StrAcademicYear
task = "SELECT * FROM QryStudentSearch WHERE & Criteria
Forms!frmStudentList.RecordSource = task
Forms!frmStudentList.Requery
End Function
There are quite a few problems with this piece of code.
Firstly, most of your variables aren't explicitly declared as being of a type, so default to being Variant.
Next, Class is a reserved word in Access, and will probably cause you problems.
If a control has no choice made, you are using LIKE '*' to select data. There is no need to do this, as by applying no filter means that all records will be returned anyway.
As it doesn't return a value, you can create this as a Sub rather than a Function.
The main problem is with how you are concatenating the different parts together.
I would rewrite the code as:
Sub sSearch()
Dim strSearch As String
If Not IsNull(Forms!frmStudentList!cboClass) Then
strSearch = strSearch & " AND [Class]='" & Forms!frmStudentList!cboClass & "' "
End If
If Not IsNull(Forms!frmStudentList!cboStateProvince) Then
strSearch = strSearch & " AND [StateProvince]='" & Forms!frmStudentList!cboStateProvince & "' "
End If
If Not IsNull(Forms!frmStudentList!cboAcademicYear) Then
strSearch = strSearch & " AND [AcademicYear]='" & Forms!frmStudentList!cboAcademicYear & "' "
End If
If Left(strSearch, 4) = " AND" Then
strSearch = "WHERE " & Mid(strSearch, 6)
End If
strSearch = "SELECT * FROM qryStudentSearch " & strSearch
Forms!frmStudentList.RecordSource = strSearch
Forms!frmStudentList.Requery
End Sub
In each case, I am assuming that the bound column of each combo box is text, hence the need to use single quotes around the data. If the bound column is numeric, then the single quotes can be removed.
Regards,

Using keywords to find records and list them in a listbox

I have a form (frmSearch) that I use several (4) comboboxes to filter out results for a listbox (lstCustomers). What I'm attempting to do now is create the ability to filter the listbox based on a text box of "keywords". Additionally, the column which the keyword box will search will be variable based on cboWhere which is a list of columns from tblContacts (the table qryContactWants uses)
I found a really nice Function set with the following code that will let me filter everything, but I'm not entirely sure how to turn this data around and use it to filter out my listbox.
This function organizes the keywords:
Public Function FindAnyWord(varFindIn, strWordList As String) As Boolean
Dim var
Dim aWords
aWords = Split(strWordList, ",")
For Each var In aWords
If FindWord(varFindIn, var) Then
FindAnyWord = True
Exit Function
End If
Next var
End Function
And this function actually performs the search:
Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean
Const PUNCLIST = """' .,?!:;(){}[]-—/"
Dim intPos As Integer
FindWord = False
If Not IsNull(varFindIn) And Not IsNull(varWord) Then
intPos = InStr(varFindIn, varWord)
' loop until no instances of sought substring found
Do While intPos > 0
' is it at start of string
If intPos = 1 Then
' is it whole string?
If Len(varFindIn) = Len(varWord) Then
FindWord = True
Exit Function
' is it followed by a space or punctuation mark?
ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
Else
' is it precedeed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
' is it at end of string or followed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
End If
End If
' remove characters up to end of first instance
' of sought substring before looping
varFindIn = Mid(varFindIn, intPos + 1)
intPos = InStr(varFindIn, varWord)
Loop
End If
End Function
And here is the code that I typically use to filter the listbox using the comboboxes on frmSearch:
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
What I would like to do is take the functions I found for searching keywords and apply it to my form and aid in returning a list of customers in lstCustomers
Ideally, having the keyword function return an SQL statement similar to those I'm using to filter out the listbox would be perfect. This would allow me to add a simple SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING
EDIT 1:
While using the following code, VBA is tossing a compile error on the second "End If" stating there isn't a Block If. There clearly is, so I'm not sure what's going on. Here is the code I'm using:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
If Trim(b) <> "" Then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
End If
End If
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
And under the function RequerylistCustomers() I added the If IsNull (Me.txtSearch) = False Then code below:
Private Sub RequerylstCustomers()
Dim SQL As String
'Dim criteria As String
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
Dim strWhere As String
'Grab Keywords from txtSearch using cboWhere to search for those keywords
If IsNull(Me.txtSearch) = False Then
strWhere = KeyWhere(Me.txtSearch, Me.cboWhere)
SQL = SQL & " AND " & strWhere
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
Are the keywords to be searched in a single column (say a comments or memo column?). If yes, then you should be able to optional "add" the one additional criteria to your current "set" of combo box filters.
Are we to assume that the keywords can appear anywhere in that memo column to search?
So, if there are "key words entered into that text box, then you call KeyWhere.
eg this routine:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
if trim(v) <> "" then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
end if
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
We assume each key word is separated by a comma (could be space, but comma is better).
So, if I type in the following command in debug window to test the above?
? keywhere("Generator, Water maker, Battery","Notes")
OutPut:
(Notes like '*Generator*' or Notes like '*Water maker*' or Notes like '*Battery*')
So, we just append the above results to your final SQL.
eg:
dim strWhere as string
if isnull(me.KeyWordBox) = False then
strWhere = keyWhere(me.KeyWordBox,me.cboColumnToSearch)
SQL = SQL & " AND " & strWhere
end if
so, the above converts all keywords into a valid SQL condition for the column to search. It is likely that column is some kind of notes column, but it would work for other description type field to search.

VBA SQL Where IS NULL

Im trying to create a VBA sql string with the where clause using inputs from an access form. I need the code to still run properly even if one of the user inputs is null/unselected. The code below runs correctly when all user inputs have been selected but when one input is null/unselected the query ends up pulling back all the records in the table.
Dim SQL As String
SQL = "SELECT qry_1.field1, qry_1.field2, qry_1.field3 INTO recordset FROM qry_1" & _
" WHERE ((qry_1.Field1) IS NULL OR (qry_1.Field1) = '" & [Forms]![frm_Parameters]![cmbx_1] & "') " &_
" AND ((qry_1.Field2) IS NULL OR (qry_1.Field2) = '" & [Forms]![frm_Parameters]![cmbx_2] & "' ) " & _
" AND ((qry_1.Field3) IS NULL OR (qry_1.Field3) = '" & [Forms]![frm_Parameters]![cmbx_3] & "') ;"
DoCmd.RunSQL SQL
It is better to escape single apostrophes in the text for two reasons
You might get an invalid SQL statement if you don't.
A nasty user could can inject evil code (see: SQL injection).
Therefore I use this function
Public Function SqlStr(ByVal s As String) As String
'Input: s="" Returns: NULL
'Input: s="abc" Returns: 'abc'
'Input: s="x'y" Returns: 'x''y'
If s = "" Then
SqlStr = "NULL"
Else
SqlStr = "'" & Replace(s, "'", "''") & "'"
End If
End Function
To account for empty entries, create the condition like this:
Dim cond As String, sql As String
If Nz([Forms]![frm_Parameters]![cmbx_1]) <> "" Then
cond = "qry_1.field1 = " & SqlStr(Nz([Forms]![frm_Parameters]![cmbx_1]))
End If
If Nz([Forms]![frm_Parameters]![cmbx_2]) <> "" Then
If cond <> "" Then cond = cond & " AND "
cond = cond & "qry_1.field2 = " & SqlStr(Nz([Forms]![frm_Parameters]![cmbx_2]))
End If
If Nz([Forms]![frm_Parameters]![cmbx_3]) <> "" Then
If cond <> "" Then cond = cond & " AND "
cond = cond & "qry_1.field3 = " & SqlStr(Nz([Forms]![frm_Parameters]![cmbx_3]))
End If
sql = "SELECT qry_1.field1, qry_1.field2, qry_1.field3 INTO recordset FROM qry_1"
If cond <> "" Then
sql = sql & " WHERE " & cond
End If
This assumes that you want to test a condition only when the corresponding field is not empty.
If you have date constants, format them the Access-SQL way as #2018-08-21# with
Format$(date, "\#yyyy-MM-dd\#")
DoCmd.RunSQL is for action queries (UPDATE, INSERT, DELETE).
To answer the question, here is what I would do:
Nz(Field1,Nz([Forms]![frm_Parameters]![cmbx_1]))=Nz([Forms]![frm_Parameters]![cmbx_1])
That will create equality if either Field1 or [Forms]![frm_Parameters]![cmbx_1] is NULL without breaking the rest of the query.
To use that in VBA:
"Nz(Field1,'" & Nz([Forms]![frm_Parameters]![cmbx_1]) & "')='" & Nz([Forms]![frm_Parameters]![cmbx_1]) & "'"
Also see comment in Olivier Jacot-Descombes answer about taking single quotes in your strings into account.

Using checkboxes values in SQL "IN"-operator

I have a form with several checkboxes in it. Values of ticking checkboxes are used after in the SQL-query including in Excel-macro. I use these values in SQL "IN"-operator. So, everythig works. But I don't like the code for my macro.
For ticking checkboxes I use such code (and if there were more value the list would be very huge):
Public Location1 As String
Public Location2 As String
Public Location3 As String
Public Location4 As String
Private Sub OKCommandButton2_Click()
If CheckBox1.Value = True Then Location1 = "LocationValue1"
If CheckBox2.Value = True Then Location2 = "LocationValue2"
If CheckBox3.Value = True Then Location3 = "LocationValue3"
If CheckBox4.Value = True Then Location4 = "LocationValue4"
...
And for using it in SQl I use such code:
query = "SELECT Param1, Param2, Param3, Param4, 0, 0, Param5, 0 FROM Table1 " & _
"WHERE Param1 like'" & "%" & CraftDefinition.Craft & "%" & "'AND Param6>0 AND Param2 IN ('" & _
LocationDefinition.Location1 & "','" & LocationDefinition.Location2 & "','" & LocationDefinition.Location3 & "','" & _
LocationDefinition.Location4 & "')" & _
"ORDER BY Param2, Param3"
The question is: can I rewrite my code in more compact, laconic and sophisticated way? Maybe I should use another operator in SQL-part; maybe I can rewrite my VBA-part, for using only one parameter in SQl.
Thank you.
you can use the "controls" Feature and write your Value into the "TAG" from the checkbox
Dim TB As Control
Dim ChkBoxString As String
ChkBoxString = "("
For Each TB In Me.Controls
If TypeOf TB Is CheckBox Then
If TB.Value = True Then
ChkBoxString = ChkBoxString & TB.Tag & ", "
End If
End If
Next TB
ChkBoxString = ChkBoxString & ")"
ChkBoxString = Replace(ChkBoxString, ", )", ")")
So you can use your Script:
query = "SELECT Param1, Param2, Param3, Param4, 0, 0, Param5, 0 FROM Table1 " & _
"WHERE Param1 like'" & "%" & CraftDefinition.Craft & "%" & "'AND Param6>0 AND Param2 " _
IN " & ChkBoxString
Greets Ralf
Create function that return string expression with comma delimited, and set the value in the Tag property of the checkbox
Function GetExpression() As String
Dim contr As Control
Dim comma As String
Dim str As String
str = ""
For Each contr In UserForm1.Controls
comma = IIf(str <> "", ",", "")
If TypeName(contr) = "CheckBox" Then
If contr.Value = True Then str = str + comma + contr.Tag
End If
Next
GetExpression = str
End Function
If the sub that "makes" the query (or build the query string) is called while the Userform is still loaded then you can code as follows:
Option Explicit
Dim Locations As String '<--| UserForm scoped variable: all subs in the userform code pane can "see" it
Private Sub OKCommandButton2_Click()
Dim ctrl As Control
For Each ctrl In Me.Controls '<--| loop through userform controls
If TypeName(ctrl) = "CheckBox" Then '<--| consider only checkboxes
If ctrl.value Then Locations = Locations & "LocationValue" & Mid(ctrl.Name, 9, Len(ctrl.Name) - 8) & "','" '<--| if checkbox is checked then update 'Location' string
End If
Next ctrl
End Sub
Private Sub QuerySub() '<-- name of any Sub inside Userfom code pane that has to make the query
Dim Query As String
If Locations <> "" Then '<--| this Sub can "see" 'Locations' even if it has been initialized in a different Sub of the same Userform code pane
Query = "SELECT Param1, Param2, Param3, Param4, 0, 0, Param5, 0 FROM Table1 " & _
"WHERE Param1 like'" & "%" & CraftDefinition.Craft & "%" & "'AND Param6>0 AND Param2 IN ('" & _
Left(Locations, Len(Locations) - 3) & "')" & _
"ORDER BY Param2, Param3"
Else
' code to handle 'Locations' empty string
End If
End Sub
This seems a tiny bit wrong because you get IN ('', '', '', '') when unchecked, but if you don't mind that, then maybe something like this:
locations$ = Mid$( _
IIf(CheckBox1, "','LocationValue1", "") & _
IIf(CheckBox2, "','LocationValue2", "") & _
IIf(CheckBox3, "','LocationValue3", "") & _
IIf(CheckBox4, "','LocationValue4", ""), 4) ' works even is all unchecked
query = " ... AND Param2 IN ('" & locations & "') ORDER BY Param2, Param3"
or if all of the values really start with "LocationValue" then
Locations$ = Mid$(Replace(IIf(CheckBox1, ",1", "") & _
IIf(CheckBox2, ",2", "") & IIf(CheckBox3, ",3", "") & _
IIf(CheckBox4, ",4", ""), ",", "','LocationValue"), 4)

Ms-Access how to use a query with a parameter inside a form

I have an SQL query with a question(alert like) that pops up every time I open it...
For every value inserted in that question you get diffrent result.
I Want to be able to use that query in my form with a combo-box...
I don't know how to exceute the query with the parameter from within the form....
I have no problem using VBA, just tell me how to call the query with the parameter
Thanks,
Fingerman
I usually use my filtering forms using the following principles:
1) I first create a query that includes all the fields I want to display and all the fields I want to filter on. It can use more than one table. I do not set any criteria (WHERE clause) in this query unless there is a condition that always needs to be applied no matter what.
2) Next I create a datasheet form based on this query and I save it, giving it a name that indicates that it's a subform.
3) Next I create an unbound main form and add unbound controls such as textboxes, combos, listboxes, checkboxes, etc. that will be used to filter the different fields. One control can potentially allow a user to search on more than one field depending how you write your filtering routine in VBA.
4) Now it's time to write code on the main form to make this all work. Basically, the code needs to check to see if there are values in any of the controls and if so, it creates a WHERE clause (without the WHERE keyword) and at the very end it sets the subform's filter property and turns the subform's FilterOn property to TRUE.
Here's some example code. This was taken from the sample database I've made just to demonstrate filtering (see below). This example does not use fuzzy searches (asterisks) and each control on the main form only filters one field on the subform.
Private Sub cmdFilter_Click()
'You can also call the FilterSubForm function on a control's AfterUpdate event.
Call FilterSubform
End Sub
Private Sub FilterSubform()
Dim strFilter As String
'Note: We have to wrap field names in brackets if they contain spaces or
'special characters. These fields are in Northwind Traders 2007 from Microsoft
'I would never consider naming my fields with spaces or special characters
'in them.
'Company
If Nz(Me.txtCompany, "") <> "" Then
strFilter = strFilter & "Company = '" & PQ(Me.txtCompany) & "' And "
End If
'First Name
If Nz(Me.txtFirstName, "") <> "" Then
strFilter = strFilter & "[First Name] = '" & PQ(Me.txtFirstName) & "' AND "
End If
'Last Name
If Nz(Me.txtLastName, "") <> "" Then
strFilter = strFilter & "[Last Name] = '" & PQ(Me.txtLastName) & "' AND "
End If
'Business Phone
If Nz(Me.txtBusinessPhone, "") <> "" Then
strFilter = strFilter & "[Business Phone] = '" & PQ(Me.txtBusinessPhone) & "' AND "
End If
'City
If Nz(Me.cboCity, "") <> "" Then
strFilter = strFilter & "City = '" & PQ(Me.cboCity) & "' AND "
End If
'State/Province
If Nz(Me.cboStateProvince, "") <> "" Then
strFilter = strFilter & "[State/Province] = '" & PQ(Me.cboStateProvince) & "' AND "
End If
'Order Date
If Nz(Me.txtOrderDate, "") <> "" Then
If IsDate(Me.txtOrderDate) = True Then
strFilter = strFilter & "[Order Date] = #" & Me.txtOrderDate & "# AND "
End If
End If
'Ship Name
If Nz(Me.txtShipName, "") <> "" Then
strFilter = strFilter & "[Ship Name] = '" & PQ(Me.txtShipName) & "' AND "
End If
'Ship City
If Nz(Me.txtShipCity, "") <> "" Then
strFilter = strFilter & "[Ship City] = '" & PQ(Me.txtShipCity) & "' AND "
End If
'Ship State/Province
If Nz(Me.cboShipStateProvince, "") <> "" Then
strFilter = strFilter & "[Ship State/Province] = '" & PQ(Me.cboShipStateProvince) & "' AND "
End If
'Product Code
If Nz(Me.cboProductCode, "") <> "" Then
strFilter = strFilter & "[Product Code] = '" & PQ(Me.cboProductCode) & "' AND "
End If
'Quantity
If Nz(Me.txtQuantity, "") <> "" Then
If IsNumeric(Me.txtQuantity) = True Then
strFilter = strFilter & "Quantity = " & Me.txtQuantity & " AND "
End If
End If
If Right(strFilter, 5) = " AND " Then strFilter = Left(strFilter, Len(strFilter) - 5)
If strFilter <> "" Then
Me.subformOrderSearch.Form.Filter = strFilter
Me.subformOrderSearch.Form.FilterOn = True
Else
'Clear the filter
Me.subformOrderSearch.Form.Filter = ""
Me.subformOrderSearch.Form.FilterOn = False
End If
End Sub
Private Function PQ(s As String) As String
'This function is used to "pad quotes" for SQL
PQ = Replace(s, "'", "''")
End Function
I've put together a sample database that has several different examples all building on what I've posted here. You can download this database here:
http://www.utteraccess.com/forum/Search-filtering-Examples-t1968063.html
After some Searching, I have came across this:
http://www.techrepublic.com/blog/msoffice/run-a-parameter-query-within-an-access-form/701
It is not what I wanted, But it is a great solution...
I will wait, if no one gets a better answer, I'll accept my own (As much as I hate doing that).