具有一个列表框，该列表框对作为查询的子表单中的项目进行过滤

Question

我有一个列表框，该框具有三个不同的类别，可从表单上选择。我有可以正常工作的vba代码，可以在列表框中选择多个项目。但是我选择的项目很难获得所需的结果。

例如；列表框内的三个类别不在具有实际类别名称的查询中。我拥有的一个类别称为“选择”，我要选择“选择”，然后单击按钮时，我希望它拉出查询字段“ Item Number”中等于“ 0801”的所有类别，代表“类别”采摘”。

注意按钮后面的代码是一个简单的“ On Click”事件过程

**我遇到麻烦的列表框称为（StrAccounts）

**选择与我尝试在tbUpload中过滤的查询中的Acct相同

**我希望列表框中的“ Picking”类别能够在Acct ='0801'的查询中根据Acct进行过滤

** Placed_Orders，它在我的ListBox中的第二个类别名称，与“ tbUpload”，Acct以上查询中的相同字段，除了我想要的此Placed_Orders以获得所有Acct in（'1108'，'1114'，'1117'，'1113'，'1110'）

**无论查询tbUpload中的哪个帐户不包含上面已经提到的以下数字，都是我的第三类列表框是“ Not_Placed”

**因此，每当单击列表框中的Not_Placed并选择搜索按钮时，我都希望查询中的Accts成为Accts <>'0801'，'1108'，'1114'，'1117'，'1113'，'1110'

Private Sub cmdSearch_Click()
Dim Varitem As Variant
Dim StrDEPT_OBS As String
Dim StrStatus As String
Dim StrACCT As String
Dim strSQL As String
Dim StrAccounts As String

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me!List_Dept_OBS.ItemsSelected
StrDEPT_OBS = StrDEPT_OBS & ",'" & Me!List_Dept_OBS.ItemData(Varitem) & "'"
Next

'get selections from Status multiselect listbox
For Each Varitem In Me!List_Status.ItemsSelected
StrStatus = StrStatus & ",'" & Me!List_Status.ItemData(Varitem) & "'"
Next

'get selections from Accts multiselect listbox
 For Each Varitem In Me!List_ACCTs.ItemsSelected
 StrStatus = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
 Next



 If Len(StrDEPT_OBS) > 0 Then
 StrDEPT_OBS = Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1)
 Else: MsgBox "You must enter an OBS"

 Exit Sub
 End If

 If Len(StrStatus) > 0 Then
 StrStatus = Right(StrStatus, Len(StrStatus) - 1)
 End If

 If Len(StrAccounts) > 0 Then
 StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
  End If



  strSQL = " SELECT * FROM tbUpload WHERE "
  strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStatus & ") "
   End If



    If Len(StrAccounts) = 0 And StrAccounts = "Picking" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If Len(StrAccounts) = 0 And StrAccounts = "Placed_Orders" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
        strSQL = strSQL & "tbUpload.ACCT <> (" & [0801] & [1108] & [1114] & [1117] & [1113] & [1110] & ") " "Not_Placed"
End If




DoCmd.SetWarnings False
''DoCmd.OpenQuery ("UPLOAD")
 Me![tbUpload subform].Form.RecordSource = strSQL

 End Sub









If Len(StrAccounts) > 0 Then
'' StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
StrAccounts = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
End If


strSQL = " SELECT * FROM tbUpload WHERE "
strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStat   us & ") "
   End If



    If StrAccounts = "Lugging" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If StrAccounts = "Structure" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
    End If

Answer 1

考虑：

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me.List_Dept_OBS.ItemsSelected
   StrDEPT_OBS = StrDEPT_OBS & ",'" & Me!List_Dept_OBS.ItemData(Varitem) & "'"
Next

If Len(StrDEPT_OBS) > 0 Then
    StrDEPT_OBS = "[Dept_ID] IN(" & Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1) & ") AND "
Else
    MsgBox "You must enter an OBS"
    Exit Sub
End If

'get selections from Status multiselect listbox
For Each Varitem In Me.List_Status.ItemsSelected
    StrStatus = StrStatus & ",'" & Me.List_Status.ItemData(Varitem) & "'"
Next

If Len(StrStatus) > 0 Then
   StrStatus = "[OPR_STAT_ID] IN(" & Right(StrStatus, Len(StrStatus) - 1) & ") AND "
End If

'get selection from Accts single select listbox and build string account array
Select Case Me.List_Accts
    Case "Picking"
        StrAccounts = "ACCT = 0801 AND "
    Case "Placed_Orders"
        StrAccounts = "ACCT IN(1108,1114,1117,1113,1110) AND "
    Case "Not_Placed"
        StrAccounts = "NOT ACCT IN(0801,1108,1114,1117,1113,1110) AND "
End Select

strSQL = StrDEPT_OBS & StrStatus & StrAccounts
If strSQL <> "" Then
    strSQL = Left(strSQL, Len(strSQL) - 5)
End If

Me.[tbUpload subform].Form.RecordSource = "SELECT * FROM tbUpload WHERE " & strSQL

有关使用VBA动态建立搜索条件的更多信息，请查看http://allenbrowne.com/ser-62.html