【问题标题】:VBA Query based on multiple "multiple select list boxes" in Access when not selecting an item from one of the multiple select boxes当未从多个选择框之一中选择项目时,基于 Access 中的多个“多个选择列表框”的 VBA 查询
【发布时间】: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

【问题讨论】:

    标签: sql vba ms-access listbox


    【解决方案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 “它就像一个魅力!!!
    • 很好的调试工作。编写的代码越多,您就越需要这项技能!
    • 我修改了答案以使用您的修复。
    猜你喜欢
    • 2021-11-26
    • 1970-01-01
    • 2018-04-16
    • 1970-01-01
    • 1970-01-01
    • 2021-11-23
    • 1970-01-01
    • 2010-10-06
    • 1970-01-01
    相关资源
    最近更新 更多