NascarBaritone
Registered User.
- Local time
- Today, 08:45
- Joined
- Sep 23, 2008
- Messages
- 75
I am as stumped as one person can possibly be and now I'm just chasing my tail.
I have a relatively simple form that allows a user to filter a report and then view it. Two of the fields that I want to add are multiselect listboxes set to Simple. I have placed the code I found on http://www.mvps.org/access/forms/frm0007.htm in every nook and cranny of my code and can't seem to get the listboxes to pass their values to the SQL query.
Below is my code and the code I was trying to put in. Any suggestions so I can finally catch my tail?
My code (without listboxes):
Multiselect textbox code that I was hoping to add for my two listboxes (txtRecipients and txtAreasNotified):
I have a relatively simple form that allows a user to filter a report and then view it. Two of the fields that I want to add are multiselect listboxes set to Simple. I have placed the code I found on http://www.mvps.org/access/forms/frm0007.htm in every nook and cranny of my code and can't seem to get the listboxes to pass their values to the SQL query.
Below is my code and the code I was trying to put in. Any suggestions so I can finally catch my tail?
My code (without listboxes):
Code:
Private Sub cmdSearch_Click()
On Error GoTo cmdOK_Click_Err
Dim blnQueryExists As Boolean
Dim cat As New ADOX.Catalog
Dim cmd As New ADODB.Command
Dim qry As ADOX.View
Dim strSQL As String
Dim strWhere As String
Dim strCondition As String
Const conJetDate = "\#mm\/dd\/yyyy\#"
blnQueryExists = False
Set cat.ActiveConnection = CurrentProject.Connection
For Each qry In cat.Views
If qry.Name = "qrySearch" Then
blnQueryExists = True
Exit For
End If
Next qry
' Create the query if it does not already exist
If blnQueryExists = False Then
cmd.CommandText = "SELECT * FROM tblRegUpdates"
cat.Views.Append "qrySearch", cmd
End If
Application.RefreshDatabaseWindow
' Turn off screen updating
DoCmd.Echo False
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "qrySearch") = acObjStateOpen Then
DoCmd.Close acQuery, "qrySearch"
End If
If Me.optAnd = True Then
strCondition = " AND "
Else
strCondition = " OR "
End If
If Len(Me.cmbStateEntity & "") <> 0 Then
strWhere = "[State_Entity]=" & Chr(34) & Me.cmbStateEntity & Chr(34) & strCondition
End If
If Len(Me.cmbCategory & "") <> 0 Then
strWhere = strWhere & "[Category]= " & Chr(34) & Me.cmbCategory & Chr(34) & strCondition
End If
If Len(Me.txtDescription & "") <> 0 Then
strWhere = strWhere & "[Description] Like '*" & Me.txtDescription & "*'" & strCondition
End If
If Len(Me.txtDateReceivedStart & "") <> 0 Then
strWhere = strWhere & "([Date_Received] Between " & Format(Me.txtDateReceivedStart, conJetDate) & " And " & Format(Me.txtDateReceivedEnd, conJetDate) & ")" & strCondition
End If
If Len(Me.txtDateDistributedStart & "") <> 0 Then
strWhere = strWhere & "([Date_Distributed] Between " & Format(Me.txtDateDistributedStart, conJetDate) & " And " & Format(Me.txtDateDistributedEnd, conJetDate) & ")" & strCondition
End If
If Len(Me.cmbPreparer & "") <> 0 Then
strWhere = strWhere & "[Preparer] = " & Chr(34) & Me.cmbPreparer & Chr(34) & strCondition
End If
If Right(strWhere, 5) = " AND " Then
strWhere = Left(strWhere, Len(strWhere) - 5)
ElseIf Right(strWhere, 4) = " OR " Then
strWhere = Left(strWhere, Len(strWhere) - 4)
End If
strWhere = "WHERE " & strWhere
strSQL = "SELECT tblRegUpdates.*, subRecipientQuery.RecipientListID, subAreasNotifiedQuery.ListID, subCCQuery.CCListID FROM ((tblRegUpdates LEFT JOIN subRecipientQuery ON tblRegUpdates.Record_ID = subRecipientQuery.Record_ID) LEFT JOIN subAreasNotifiedQuery ON tblRegUpdates.Record_ID = subAreasNotifiedQuery.Record_ID) LEFT JOIN subCCQuery ON tblRegUpdates.Record_ID = subCCQuery.Record_ID " & strWhere & ";"
cat.ActiveConnection = CurrentProject.Connection
Set cmd = cat.Views("qrySearch").Command
cmd.CommandText = strSQL
Set cat.Views("qrySearch").Command = cmd
Set cat = Nothing
MsgBox strSQL
DoCmd.OpenForm "frmDialog"
cmdOK_Click_Exit:
DoCmd.Echo True
Exit Sub
cmdOK_Click_Err:
On Error Resume Next
End SubMultiselect textbox code that I was hoping to add for my two listboxes (txtRecipients and txtAreasNotified):
Code:
Dim frm As Form, ctl As Control
Dim varItem As Variant
Dim strSQL As String
Set frm = Form!frmMyForm
Set ctl = frm!lbMultiSelectListbox
strSQL = "Select * from Employees where [EmpID]="
[B]'Assuming long [EmpID] is the bound field in lb[/B]
[B] 'enumerate selected items and[/B]
[B] 'concatenate to strSQL[/B]
For Each varItem In ctl.ItemsSelected
strSQL = strSQL & ctl.ItemData(varItem) & " OR [EmpID]="
Next varItem
[B]'Trim the end of strSQL[/B]
strSQL=left$(strSQL,len(strSQL)-12))
