文本框的搜索功能，当文本框和列表框有 none 个条目时，让我的功能仍然运行

Question

我真正需要知道的是如何在多个多 select 列表框中创建 selection，但将其中任意数量的列表框留空并且仍然有 macro/query 无需输入有关它的错误消息即可工作。

这还包括对文本框执行相同的操作。文本框的功能与列表框相同，它们会在数据 table 中搜索任何内容以匹配我在记录中查找的内容，并在 table.[= 中显示我正在查找的内容13=]

这是我的代码

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

然后可以使用列表框控件参数对其进行评估，并且 return 列表框中所选项目的空字符串 ("") 或以逗号分隔的字符串，例如类似于：

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

此外，由于您的表单控件似乎相对于 table 中的字段命名一致，您可以进一步将代码压缩为以下几行：

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 循环遍历与表单控件名称和 table 字段名称相对应的字符串数组。

对于此数组中的每个表单控件，该函数获取控件中所选项目的逗号分隔字符串，并且仅当已选择一个或多个项目时才将其与现有 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

希望对您有所帮助，但请注意，以上内容未经测试，仅为理论。

文本框的搜索功能，当文本框和列表框有 none 个条目时，让我的功能仍然运行

Searching function for textbox and letting my function still run when there are none entries in for the textbox and listbox

ms-access

vba

textbox

listbox

multi-select

文本框的搜索功能，当文本框和列表框有 none 个条目时，让我的功能仍然 运行

Searching function for textbox and letting my function still run when there are none entries in for the textbox and listbox

ms-access

vba

textbox

listbox

multi-select

文本框的搜索功能，当文本框和列表框有 none 个条目时，让我的功能仍然运行