Option Compare Database
Option Explicit
Dim whr As Dictionary
Dim sql, cp, cw As String
Dim wrd
Private Sub Courses_AfterUpdate()
Me.Requery
End Sub
Private Sub Form_Open(Cancel As Integer)
Reset_btn_Click
sql = Replace(CurrentDb.QueryDefs("Results_RAW").sql, ";", "")
Set whr = New Dictionary
wrd = Array("'@txt *'", "'* @txt *'", "'* @txt'", "'@txt'")
cp = Part_Criteria("S.FullName")
cw = Word_Criteria("S.FullName")
End Sub
Private Sub Reset_btn_Click()
Me.Student_tb = ""
Me.Years_cb = Me.Years_cb.ItemData(0)
Me.Terms_cb = Me.Terms_cb.ItemData(0)
DoCmd.RunSQL ("DELETE Search.Courses.value FROM Search")
Me.Courses.Requery
Me.Results.Visible = False
Me.Results.RowSource = ""
Me.Status_lbl.Caption = ""
End Sub
Function Part_Criteria(FieldName As String) As String
Part_Criteria = FieldName & " Like '*@txt*'"
End Function
Function Word_Criteria(FieldName As String) As String
Dim tmp(3) As String
Dim i As Integer
For i = 0 To 3
tmp(i) = FieldName & " Like " & wrd(i)
Next i
Word_Criteria = "(" & Join(tmp, " OR ") & ")"
End Function
Private Sub Search_btn_Click()
Me.Status_lbl.Caption = ""
whr.RemoveAll
Dim txt As String
Dim i As Integer
Dim D As New Dictionary
txt = Me.Student_tb
If txt = "" Then GoTo Next_Step
Dim Texts
Texts = Split(txt)
If Me.Student_Search_Type_og = 1 Then ' entire phrase anywhere
whr.Add whr.Count + 1, Replace(cp, "@txt", txt)
Else
For i = 0 To UBound(Texts)
If Len(Texts(i)) > 1 Then
Select Case Me.Student_Search_Type_og
Case 2, 3 ' any part / all parts
D.Add D.Count + 1, Replace(cp, "@txt", Texts(i))
Case 4, 5 ' any word / all words
D.Add D.Count + 1, Replace(cw, "@txt", Texts(i))
End Select
End If
Next
Select Case Me.Student_Search_Type_og
Case 2, 4 ' any part / any word
whr.Add whr.Count + 1, "(" & Join(D.Items, " OR ") & ")"
Case 3, 5 ' all parts / all words
whr.Add whr.Count + 1, "(" & Join(D.Items, " AND ") & ")"
End Select
End If
Next_Step:
If Val(Me.Years_cb) > 0 Then
whr.Add whr.Count + 1, "C.Year=" & Me.Years_cb
End If
If Val(Me.Terms_cb) > 0 Then
whr.Add whr.Count + 1, "C.Term=" & Me.Terms_cb
End If
If Not IsNull(Me.Courses.Value) Then
whr.Add whr.Count + 1, "C.CourseTitleID IN (" & Join(Me.Courses.Value, ",") & ")"
End If
If whr.Count = 0 Then
Me.Status_lbl.Caption = "Atleast 1 criteria should be specified!"
Else
Bind (sql + " WHERE " + Join(whr.Items, " AND "))
End If
End Sub
Private Sub Bind(RowSource As String)
Me.Results.RowSource = RowSource
Dim n As Integer
n = Me.Results.ListCount
Me.Status_lbl.Caption = IIf(n = 0, 0, n - 1) & " records found"
Me.Results.Visible = n > 0
End Sub
Private Sub ShowAll_btn_Click()
Reset_btn_Click
Bind (sql)
End Sub
Private Sub Student_tb_AfterUpdate()
Dim txt As String
txt = Trim(Nz(Me.Student_tb.Text, ""))
Dim regexp As New regexp
regexp.Global = True
regexp.Pattern = "\s+"
Me.Student_tb = regexp.Replace(txt, " ")
End Sub
Private Sub Terms_cb_AfterUpdate()
If Nz(Me.Terms_cb, "") = "" Then
Me.Terms_cb = Me.Terms_cb.ItemData(0)
End If
End Sub
Private Sub Terms_cb_NotInList(NewData As String, Response As Integer)
Me.Terms_cb = Me.Terms_cb.ItemData(0)
Response = acDataErrContinue
End Sub
Private Sub Years_cb_AfterUpdate()
If Nz(Me.Years_cb, "") = "" Then
Me.Years_cb = Me.Years_cb.ItemData(0)
End If
End Sub
Private Sub Years_cb_NotInList(NewData As String, Response As Integer)
Me.Years_cb = Me.Years_cb.ItemData(0)
Response = acDataErrContinue
End Sub
پاسخ با نقل قول
نوشته شده توسط moustafa
