搜索文本框的函数，并在文本框和列表框中没有条目时让我的函数仍然运行

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

首先，由于您为每个表单控件重复执行相同的操作（在这种情况下，从所选项目构造逗号分隔的字符串），您可以将此操作抽象为函数，并将每个列表框函数传递给此函数。

例如，您可以定义一个函数，例如：

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循环遍历一个字符串数组，这些字符串对应于表单控件的名称和表字段的名称。

对于此数组中的每个表单控件，该函数获取控件中所选项的逗号分隔字符串，并且仅当已选择一个或多个项时才将其与现有SQL代码连接。

因此，如果未选择项目，则该字段将不会出现在SQL where子句中。

如果选择了任何过滤器，则会从SQL字符串的末尾修剪尾随的五个字符（and），并将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

我希望这会有所帮助，但请注意，上述内容尚未经过测试，只有理论。