当未从多个选择框之一中选择项目时，基于 Access 中的多个“多个选择列表框”的 VBA 查询

Posted 2023-05-07

【中文标题】当未从多个选择框之一中选择项目时，基于 Access 中的多个“多个选择列表框”的 VBA 查询

【英文标题】：VBA Query based on multiple "multiple select list boxes" in Access when not selecting an item from one of the multiple select boxes

【发布时间】：2016-07-30 01:11:56

【问题描述】：

我有以下 vba 在测试 Access 数据库中创建查询。我有两个多选列表框。问题是，我希望能够从“Me！[State]”中选择多个项目，而从“Me！[Animal]”中选择多个项目，并且能够运行查询。但是，这是不可能的，因为没有设置查询语言来处理它。它让我从“我！[动物]”中选择一些东西。

如果多个列表框之一没有选择任何内容或两者都有选择，我如何修改下面的 vba 以允许我查询两个多选列表框？

Private Sub Command6_Click()


  Dim Q As QueryDef, DB As Database
   Dim Criteria As String
   Dim ctl As Control
   Dim Itm As Variant
   Dim ctl2 As Control
   Dim ctl3 As Control
   ' Build a list of the selections.


   Set ctl = Me![Animal]
   For Each Itm In ctl.ItemsSelected
      If Len(Criteria) = 0 Then
         Criteria = Chr(34) & ctl.ItemData(Itm) & Chr(34)
      Else
         Criteria = Criteria & "," & Chr(34) & ctl.ItemData(Itm) _
          & Chr(34)
      End If
   Next Itm
   If Len(Criteria) = 0 Then
      Itm = MsgBox("You must select one or more items in the" & _
        " list box!", 0, "No Selection Made")
      Exit Sub
   End If



      Set ctl2 = Me![State]
   For Each Itm In ctl2.ItemsSelected
      If Len(Criteria2) = 0 Then
         Criteria2 = Chr(34) & ctl2.ItemData(Itm) & Chr(34)
      Else
         Criteria2 = Criteria2 & "," & Chr(34) & ctl2.ItemData(Itm) _
          & Chr(34)
      End If
   Next Itm
   If Len(Criteria2) = 0 Then
      Itm = MsgBox("You must select one or more items in the" & _
        " list box!", 0, "No Selection Made")
      Exit Sub
   End If




   ' Modify the Query.
   Set DB = CurrentDb()
   Set Q = DB.QueryDefs("animalquery")
   ' Modify the Query.
   Set DB = CurrentDb()
   Set Q = DB.QueryDefs("animalquery")
   Q.SQL = "Select * From [table1] Where [table1].[type] In (" & "'Animal'" & _
     ")" & " and [table1].[animal] in (" & Criteria & _
     ")" & " and [table1].[state] in (" & Criteria2 & _
     ")" & ";"
   Q.Close

   ' Run the query.
   DoCmd.OpenQuery "animalquery"
End Sub

【参考方案1】：

编辑 - 根据评论修复比较

您可以通过简单检查您的 Criteria 变量来做到这一点。

您已经进行了长度检查 - 稍后在构建动态 SQL 时使用它。

我添加了一个 strSQL 变量，以便更轻松地跟踪正在发生的事情。并调整错误消息以允许一个或其他条件为空

Private Sub Command6_Click()

    Dim Q           As QueryDef
    Dim DB          As Database
    Dim Criteria    As String
    Dim ctl         As Control
    Dim Itm         As Variant
    Dim ctl2        As Control
    Dim ctl3        As Control

    ' Use for dynamic SQL statement'
    Dim strSQL      As String

    Set ctl = Me![Animal]
    For Each Itm In ctl.ItemsSelected
        If Len(Criteria) = 0 Then
            Criteria = Chr(34) & ctl.ItemData(Itm) & Chr(34)
        Else
            Criteria = Criteria & "," & Chr(34) & ctl.ItemData(Itm) & Chr(34)
        End If
    Next Itm

    Set ctl2 = Me![State]
    For Each Itm In ctl2.ItemsSelected
        If Len(Criteria2) = 0 Then
            Criteria2 = Chr(34) & ctl2.ItemData(Itm) & Chr(34)
        Else
            Criteria2 = Criteria2 & "," & Chr(34) & ctl2.ItemData(Itm) & Chr(34)
        End If
    Next Itm

    If (Len(Criteria) = 0) And (Len(Criteria2) = 0) Then
        Itm = MsgBox("You must select one or more items from one of the list boxes!", 0, "No Selection Made")
        Exit Sub
    End If

    ' Modify the Query.
    Set DB = CurrentDb()
    Set Q = DB.QueryDefs("animalquery")
    ' Modify the Query.
    Set DB = CurrentDb()
    Set Q = DB.QueryDefs("animalquery")

    strSQL = "Select * From [table1] Where [table1].[type] In (" & "'Animal')"

    If (Len(Criteria) <> 0) Then ' Append Animal Criteria
        strSQL = strSQL & " AND [table1].[animal] IN (" & Criteria & ")"
    End If
    If (Len(Criteria2) <> 0) Then ' Append State Criteria
        strSQL = strSQL & " AND [table1].[state]  IN (" & Criteria2 & ")"
    End If

    Q.SQL = strSQL
    Q.Close

    ' Run the query.
    DoCmd.OpenQuery "animalquery"
End Sub

【讨论】：

感谢您的快速回复！我看到你在那里做了什么，它确实让你更容易理解！但是，我收到一个错误

太完美了！更容易跟风！！！不过，我确实不得不改变一下。对于“If (Len(Criteria) = 0) Then ' Append Animal Criteria”和“If (Len(Criteria2) = 0) Then ' Append State Criteria”，我不得不将“=0”更改为“=0 “它就像一个魅力！！！

很好的调试工作。编写的代码越多，您就越需要这项技能！

我修改了答案以使用您的修复。