Функция поиска для текстового поля и позволяющая моей функции все еще работать, когда нет никаких записей для текстового поля и списка

Question

Все, что мне действительно нужно знать, это как сделать так, чтобы я мог делать выборки в нескольких списках множественного выбора, но оставить любое их число пустым и при этом работать макрос / запрос без необходимости помещать сообщение об ошибке оЭто.

Это также включает в себя то же самое с текстовыми полями.Текстовые поля будут работать так же, как списки, в которых они будут искать что-либо в таблице данных, чтобы соответствовать тому, что я ищу в записях, и отображать то, что я ищу в таблице.

Вот мой код

Private Sub Command62_Click()

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim District As String
Dim Circumstance As String
Dim Location As String
Dim Method As String
Dim Point As String
Dim Rank As String
Dim strSQL As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryMultiselect")

For Each varItem In Me!District.ItemsSelected
District = District & ",'" & Me!District.ItemData(varItem) & "'"
Next varItem

If Len(District) = 0 Then
MsgBox "You did not select anything in the Distrcit field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
District = Right(District, Len(District) - 1)

For Each varItem In Me!Circumstance.ItemsSelected
Circumstance = Circumstance & ",'" & Me!Circumstance.ItemData(varItem) & 
"'"
Next varItem

If Len(Circumstance) = 0 Then
MsgBox "You did not select anything in the Circumstance field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Circumstance = Right(Circumstance, Len(Circumstance) - 1)

For Each varItem In Me!Location.ItemsSelected
Location = Location & ",'" & Me!Location.ItemData(varItem) & "'"
Next varItem

If Len(Location) = 0 Then
MsgBox "You did not select anything in the Location field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Location = Right(Location, Len(Location) - 1)

For Each varItem In Me!Method.ItemsSelected
Method = Method & ",'" & Me!Method.ItemData(varItem) & "'"
Next varItem

If Len(Method) = 0 Then
MsgBox "You did not select anything in the Method field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Method = Right(Method, Len(Method) - 1)

For Each varItem In Me!Point.ItemsSelected
Point = Point & ",'" & Me!Point.ItemData(varItem) & "'"
Next varItem

If Len(Point) = 0 Then
MsgBox "You did not select anything in the Point field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Point = Right(Point, Len(Point) - 1)

For Each varItem In Me!Rank.ItemsSelected
Rank = Rank & ",'" & Me!Rank.ItemData(varItem) & "'"
Next varItem

If Len(Rank) = 0 Then
MsgBox "You did not select anything in the Rank field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Rank = Right(Rank, Len(Rank) - 1)

strSQL = "SELECT * FROM tblDataEntry " & _"WHERE tblDataEntry.District 
IN(" & District & ") AND tblDataEntry.Circumstance IN(" & Circumstance & 
") AND tblDataEntry.Location IN(" & Location & ") AND tblDataEntry.Method 
IN (" & Method & ") AND tblDataEntry.Point IN (" & Point & ") AND 
tblDataEntry.Rank IN(" & Rank & ");"

qdf.SQL = strSQL

DoCmd.OpenQuery "qryMultiselect"
Set db = Nothing
Set qdf = Nothing

End Sub

Мне все еще нужно добавить текстовые поля, но я не уверен, где.(Обратите внимание, что я все еще изучаю VBA).

Answer 1

Во-первых, поскольку вы неоднократно выполняете одну и ту же операцию для каждого элемента управления формы (в этом случае вы создаете строку с разделителями-запятыми из выбранных элементов), вы можете абстрагировать эту операцию от функции и передавать такую ​​функцию каждому списку.Функция Box.

Например, вы можете определить функцию, такую ​​как:

Function SelectedItems(objBox As ListBox) As String
    Dim strRtn As String, varItm
    For Each varItm In objBox.ItemsSelected
        strRtn = strRtn & ",'" & objBox.ItemData(varItm) & "'"
    Next varItm
    If strRtn <> vbNullString Then SelectedItems = Mid(strRtn, 2)
End Function

, которая затем может быть оценена с помощью управляющего аргумента List Box и будет возвращать либо пустую строку ("") или строка с разделителями-запятыми выбранных элементов в списке, например что-то вроде:

?SelectedItems(Forms!Form1!List1)
'A','B'

Более того, поскольку элементы управления вашей формой выглядят непротиворечиво по отношению к полям в вашей таблице,вы можете дополнительно сжать ваш код до следующих строк:

Private Sub Command62_Click()
    Dim strSQL As String
    Dim strArr As String
    Dim varItm

    For Each varItm In Array("District", "Circumstance", "Location", "Method", "Point", "Rank")
        strArr = SelectedItems(Me.Controls(varItm))
        If strArr <> vbNullString Then
            strSQL = strSQL & "t." & varItm & " in (" & strArr & ") and "
        End If
    Next varItm
    If strSQL <> vbNullString Then strSQL = "where " & Left(strSQL, Len(strSQL) - 5)

    With CurrentDb.QueryDefs("qryMultiselect")
        .SQL = "select * from tblDataEntry t " & strSQL
    End With
    DoCmd.OpenQuery "qryMultiselect"
End Sub

Обратите внимание, что приведенное выше полностью не проверено.

Здесь основной цикл for each выполняет итерацию по массиву строксоответствующие именам элементов управления вашей формы и именам полей вашей таблицы.

Для каждой формы cУправляя этим массивом, функция получает разделенную запятыми строку выбранных элементов в элементе управления и объединяет ее с существующим кодом SQL, только если был выбран один или несколько элементов.

Как таковой, если нетЕсли элементы выбраны, поле не будет отображаться в предложении SQL where.

Если был выбран какой-либо фильтр, последние пять символов (and) обрезаются от конца строки SQL, иКлючевое слово where объединяется с началом строки SQL - это гарантирует, что, если фильтр не был выбран, результирующий код SQL не будет включать в себя предложение where.

Наконец, SQL дляопределение запроса обновляется, и запрос открывается в соответствии с вашим исходным кодом.

---

Если речь идет о текстовых полях, задаче просто нужно пропустить вызов на SelectedItems и получить значение текстового поля напрямую.

Вот пример со списками и текстовыми полями:

Private Sub Command62_Click()
    Dim strSQL As String
    Dim strArr As String
    Dim varItm

    For Each varItm In Array("District", "Circumstance", "Location", "Method", "Point", "Rank")
        strArr = vbNullString
        Select Case Me.Controls(varItm).ControlType
            Case acListBox
                strArr = SelectedItems(Me.Controls(varItm))
            Case acTextBox
                If Not IsNull(Me.Controls(varItm).Value) Then
                    strArr = "'" & Me.Controls(varItm).Value & "'"
                End If
        End Select
        If strArr <> vbNullString Then
            strSQL = strSQL & "t." & varItm & " in (" & strArr & ") and "
        End If
    Next varItm
    If strSQL <> vbNullString Then strSQL = "where " & Left(strSQL, Len(strSQL) - 5)

    With CurrentDb.QueryDefs("qryMultiselect")
        .SQL = "select * from tblDataEntry t " & strSQL
    End With
    DoCmd.OpenQuery "qryMultiselect"
End Sub

Надеюсь, это поможет, но учтите, чтоВыше не проверено и только теория.