More through trial and error than know how I have managed to extend Martin Green's VBA & SQL Instant Query Script to include a textbox. I have got this working in his tutorial DB (freely available in his site and attached here).
I can use this text box to search keywords in Job title, using * wildcards to make it more functional.
Ideally I'd like to be able to:
1. search on one or more possible words. For example a boolean type search: "*PA*" OR "*warehouse*" but that throws up a nil result.
Obviously I could attach another text box with and AND / OR option group condition (as per Martin's own examples). But I'd rather avoid that if possible. (I didn't even include an AND / OR option for my first additional text box because it probably wont be needed).
2. Use the form as a filter for records in a subform. I'm guessing I can build a subform into the main form and just set the source to the query?
The amended code is below, my additions are highlighted in bold italics:
I can use this text box to search keywords in Job title, using * wildcards to make it more functional.
Ideally I'd like to be able to:
1. search on one or more possible words. For example a boolean type search: "*PA*" OR "*warehouse*" but that throws up a nil result.
Obviously I could attach another text box with and AND / OR option group condition (as per Martin's own examples). But I'd rather avoid that if possible. (I didn't even include an AND / OR option for my first additional text box because it probably wont be needed).
2. Use the form as a filter for records in a subform. I'm guessing I can build a subform into the main form and just set the source to the query?
The amended code is below, my additions are highlighted in bold italics:
Code:
' This code uses ADO and ADOX and is suitable for Access 2000 (and later).
' A reference must be set to Microsoft ADO Ext. 2.7 for DDL and Security.
Private Sub cmdOK_Click()
[COLOR="red"]'tobypsl - I added the line below because it kept telling me the query already existed[/COLOR]
[COLOR="red"][B][I]CurrentDb.QueryDefs.Delete "qryStaffListQuery"[/I][/B][/COLOR]
On Error GoTo cmdOK_Click_Err
Dim blnQueryExists As Boolean
Dim cat As New ADOX.Catalog
Dim cmd As New ADODB.Command
Dim qry As ADOX.View
Dim varItem As Variant
[B][I][COLOR="Red"] Dim strTitle As String[/COLOR][/I][/B]
Dim strOffice As String
Dim strDepartment As String
Dim strGender As String
[B][I][COLOR="red"] Dim strTitleCondition As String[/COLOR][/I][/B]
Dim strDepartmentCondition As String
Dim strGenderCondition As String
Dim strSQL As String
' Check for the existence of the stored query
blnQueryExists = False
Set cat.ActiveConnection = CurrentProject.Connection
For Each qry In cat.Views
If qry.Name = "qryStaffListQuery" Then
blnQueryExists = True
Exit For
End If
Next qry
' Create the query if it does not already exist
If blnQueryExists = False Then
cmd.CommandText = "SELECT * FROM tblStaff"
cat.Views.Append "qryStaffListQuery", cmd
End If
Application.RefreshDatabaseWindow
' Turn off screen updating
DoCmd.Echo False
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "qryStaffListQuery") = acObjStateOpen Then
DoCmd.Close acQuery, "qryStaffListQuery"
End If
[COLOR="red"][B][I]' Build criteria string for Title - I just set the strTitle equal to the textbox contents.
' For Each varItem In Me.lstOffice.ItemsSelected
strTitle = "Like Forms![frmStaffListQuery]![txtTitle] "
' Next varItem
' If Len(strTitle) = 0 Then
' strTitle = "Like '*'"
' Else
' strTitle = Right(strTitle, Len(strTitle) - 1)
' strTitle = "Like '*' & strTitle & '*'"
' End If
[/I][/B][/COLOR]
' Build criteria string for Office
For Each varItem In Me.lstOffice.ItemsSelected
strOffice = strOffice & ",'" & Me.lstOffice.ItemData(varItem) & "'"
Next varItem
If Len(strOffice) = 0 Then
strOffice = "Like '*'"
Else
strOffice = Right(strOffice, Len(strOffice) - 1)
strOffice = "IN(" & strOffice & ")"
End If
' Build criteria string for Department
For Each varItem In Me.lstDepartment.ItemsSelected
strDepartment = strDepartment & ",'" & Me.lstDepartment.ItemData(varItem) & "'"
Next varItem
If Len(strDepartment) = 0 Then
strDepartment = "Like '*'"
Else
strDepartment = Right(strDepartment, Len(strDepartment) - 1)
strDepartment = "IN(" & strDepartment & ")"
End If
' Build criteria string for Gender
For Each varItem In Me.lstGender.ItemsSelected
strGender = strGender & ",'" & Me.lstGender.ItemData(varItem) & "'"
Next varItem
If Len(strGender) = 0 Then
strGender = "Like '*'"
Else
strGender = Right(strGender, Len(strGender) - 1)
strGender = "IN(" & strGender & ")"
End If
[COLOR="red"][B][I]' Get Title condition - I didn't include an option box on the form so I just set it to AND
' If Me.optAndDepartment.Value = True Then
' strDepartmentCondition = " AND "
' Else
strTitleCondition = " AND "
' End If[/I][/B][/COLOR]
' Get Department condition
If Me.optAndDepartment.Value = True Then
strDepartmentCondition = " AND "
Else
strDepartmentCondition = " OR "
End If
' Get Gender condition
If Me.optAndGender.Value = True Then
strGenderCondition = " AND "
Else
strGenderCondition = " OR "
End If
' Build SQL statement - [COLOR="Red"]I tacked my line on the end as it was less probelmatic than putting it at the front[/COLOR]
strSQL = "SELECT tblStaff.* FROM tblStaff " & _
"WHERE tblStaff.[Office] " & strOffice & _
strDepartmentCondition & "tblStaff.[Department] " & strDepartment & _
strGenderCondition & "tblStaff.[Gender] " & strGender & _
[COLOR="red"] [B][I] strTitleCondition & "tblStaff.[JobTitle] " & strTitle & ";"[/I][/B][/COLOR]
' Apply the SQL statement to the stored query
cat.ActiveConnection = CurrentProject.Connection
Set cmd = cat.Views("qryStaffListQuery").Command
cmd.CommandText = strSQL
Set cat.Views("qryStaffListQuery").Command = cmd
Set cat = Nothing
' Open the Query
DoCmd.OpenQuery "qryStaffListQuery"
' If required the dialog can be closed at this point
' DoCmd.Close acForm, Me.Name
' Restore screen updating
cmdOK_Click_Exit:
DoCmd.Echo True
Exit Sub
cmdOK_Click_Err:
MsgBox "An unexpected error hass occurred." _
& vbCrLf & "Procedure: cmdOK_Click" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description:" & Err.Description _
, vbCritical, "Error"
Resume cmdOK_Click_Exit
End Sub
Private Sub optAndDepartment_Click()
' Toggle option buttons
If Me.optAndDepartment.Value = True Then
Me.optOrDepartment.Value = False
Else
Me.optOrDepartment.Value = True
End If
End Sub
Private Sub optAndGender_Click()
' Toggle option buttons
If Me.optAndGender.Value = True Then
Me.optOrGender.Value = False
Else
Me.optOrGender.Value = True
End If
End Sub
Private Sub optOrDepartment_Click()
' Toggle option buttons
If Me.optOrDepartment.Value = True Then
Me.optAndDepartment.Value = False
Else
Me.optAndDepartment.Value = True
End If
End Sub
Private Sub optOrGender_Click()
' Toggle option buttons
If Me.optOrGender.Value = True Then
Me.optAndGender.Value = False
Else
Me.optAndGender.Value = True
End If
End Sub
