Multi select with listbox Microsoft Access - vba

I'm trying to filter a splitform with a listbox but I keep getting the error '3075'.
I used the debug tool and I got:
strSearch = "52185A, 515674B"
Task = "select * from tOrder where ([OrderID] in (52185A,515674B))"
I'm pretty sure I'm missing some quotations, however I couldn't seem to figure out where. They're all short text format.
Option Compare Database
Private Sub cmdSearch_Click()
Dim varltem As Variant
Dim strSearch As String
Dim Task As String
For Each varltem In Me!LstMatricule.ItemsSelected
strSearch = strSearch & "," & Me!LstMatricule.ItemData(varltem)
Next varltem
If Len(strSearch) = 0 Then
Task = "select * from tOrder"
Else
strSearch = Right(strSearch, Len(strSearch) - 1)
Task = "select * from tOrder where ((OrderID] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
End Sub

strSearch = strSearch & ",'" & Me!LstMatricule.ItemData(varltem) & "'"
It is difficult to see but basically I added single quotes around each varItem. You want the result to look like this:
strSearch = "'52185A', '515674B'"
Personally I would do this:
strSearch = strSearch & IIf(Len(strSearch) = 0, "", ",") & "'" & Me!LstMatricule.ItemData(varltem) & "'"
It is slightly more expensive computationally if you have more than 2-3 IDs to add but cleaner than removing the starting comma at the beginning later on.

Related

How can I resolve runtime error 3075 in VBA

I have problem running this code. It gives me Syntax error (missing operator) in query expression
Function SearchCriteria()
Dim class,StateProvince,strAcademicYear As As String
Dim task, strCriteria As String
If isNull(Forms!frmStudentList!cboClass) Then
Class = "[Class] LIKE '*' "
Else
Class = [Class] = " & Forms!frmStudentList!cboClass
End If
If isNull(Forms!frmStudentList!cboStateProvince) Then
StateProvince = "[StateProvince] LIKE '*' "
Else
StateProvince = [StateProvince] = " &
Forms!frmStudentList!cboStateProvince
End If
If isNull(Forms!frmStudentList!cboAcademicYear) Then
StrAcademicYear = "[AcademicYear] LIKE '*' "
Else
StrAcademicYear = [AcademicYear] = '" &
Forms!frmStudentList!cboAcademicYear & "'"
End If
strCriteria = Class & "AND" & StateProvince & "AND" & StrAcademicYear
task = "SELECT * FROM QryStudentSearch WHERE & Criteria
Forms!frmStudentList.RecordSource = task
Forms!frmStudentList.Requery
End Function
There are quite a few problems with this piece of code.
Firstly, most of your variables aren't explicitly declared as being of a type, so default to being Variant.
Next, Class is a reserved word in Access, and will probably cause you problems.
If a control has no choice made, you are using LIKE '*' to select data. There is no need to do this, as by applying no filter means that all records will be returned anyway.
As it doesn't return a value, you can create this as a Sub rather than a Function.
The main problem is with how you are concatenating the different parts together.
I would rewrite the code as:
Sub sSearch()
Dim strSearch As String
If Not IsNull(Forms!frmStudentList!cboClass) Then
strSearch = strSearch & " AND [Class]='" & Forms!frmStudentList!cboClass & "' "
End If
If Not IsNull(Forms!frmStudentList!cboStateProvince) Then
strSearch = strSearch & " AND [StateProvince]='" & Forms!frmStudentList!cboStateProvince & "' "
End If
If Not IsNull(Forms!frmStudentList!cboAcademicYear) Then
strSearch = strSearch & " AND [AcademicYear]='" & Forms!frmStudentList!cboAcademicYear & "' "
End If
If Left(strSearch, 4) = " AND" Then
strSearch = "WHERE " & Mid(strSearch, 6)
End If
strSearch = "SELECT * FROM qryStudentSearch " & strSearch
Forms!frmStudentList.RecordSource = strSearch
Forms!frmStudentList.Requery
End Sub
In each case, I am assuming that the bound column of each combo box is text, hence the need to use single quotes around the data. If the bound column is numeric, then the single quotes can be removed.
Regards,

How to fix this code from crashing access. I assume through some error with the loop

I got it to just make a list of everything, but I need to do some grouping. my idea was to get a list of addresses, then as I loop through those addresses, filter another query with the information I want to display. If I do that, I don't get an error, but it hangs the program. I'm assuming it's a problem with the loop, but I'm not sure how. Any suggestions?
Public Function getActionItems(strID As String, strType As String) As String
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim qdfAddress As DAO.QueryDef
Dim rst As DAO.Recordset
Dim rstAddress As DAO.Recordset
Dim s As String
Set dbs = CurrentDb
'Get the parameter query
Set qdf = dbs.QueryDefs("qryActionItems")
Set qdfAddress = dbs.QueryDefs("qryActionItemsAddresses")
'get all records
Set rst = qdf.OpenRecordset()
Set rstAddress = qdfAddress.OpenRecordset()
'get all records with the submisison number
rstAddress.filter = "submission_number=" & strID
Set rstAddressFiltered = rstAddress.OpenRecordset
'cycle through the addresses
If Not rstAddressFiltered.EOF Then
rstAddressFiltered.MoveFirst
s = s + "<strong>" & rstAddressFiltered!Address & "</strong>" & vbLf & "<ol>"
Do
'filter for the address
rst.filter = "submission_number=" & strID & "AND Address=" & """ & rstAddressFiltered!Address & """
Set rstFiltered = rst.OpenRecordset
'cycle through the records with the address
If Not rstFiltered.EOF Then
rstFiltered.MoveFirst
Do
s = s + vbTab & "<li>" & rstFiltered!Address & " - " & rstFiltered!Notes & " - " & rstFiltered!Due_date & "</li>" & vbLf
rstFiltered.MoveNext
Loop Until rstFiltered.EOF
End If
Loop Until rstAddressFiltered.EOF
s = s + "</ol>"
End If
End Function
Edit: I think it may be that I missed the .movenext, but I haven’t had a chance to try it.
The main query has
submission_number, type, address, notes
I'm trying to get something like
123 main st
Foo bar
Bar foo
126 main st
Notes
When I run the query I won't know what or how many addresses I have. So I thought I would use query1 to grab the addresses, then use the addresses in query1 to filter query2, printing those results.
If you see a better approach, I'm open!
Filter criteria has syntax errors. Need a space in front of AND. Quote mark delimiters are wrong. Use apostrophe instead of trying to double up quote mark.
rst.filter = "submission_number=" & strID & " AND Address='" & rstAddressFiltered!Address & "'"

Run-time error '3075': syntax error in query expression

I am creating a form on Access to filter a Subform based on the Column name "Control Type".
I am using a listbox to choose multiple values to filter with.
I also have a button that will execute the filter to the form.
I wrote this code:
Private Sub cmdSearch_Click()
Dim varItem As Variant
Dim strSearch As String
Dim Task As String
For Each varItem In Me!listControl.ItemsSelected
strSearch = strSearch & "," & Me!listControl.ItemData(varItem)
Next varItem
If Len(strSearch) = 0 Then
Task = "select * from tblAB"
Else
strSearch = Right(strSearch, Len(strSearch) - 1)
Task = "select * from tblAB where Control_Type = '" & strSearch & "' "
End If
Me.tblAB_subform.Form.Filter = Task
Me.tblAB_subform.Form.FilterOn = True
End Sub
I am getting a Run=time error '3075' for the line:
Task = "select * from tblAB where Control_Type = '" & strSearch & "' "
Run time error must not be on refered line.
From documentation:
The Filter property is a string expression consisting of a WHERE
clause without the WHERE keyword.
So is not a complete SELECT sentence, but just:
Task = "Control_Type = '" & strSearch & "'"

outlook macro advanced search

I would like to create a macro to perform an "Advanced Search" on tasks subject and optionally tasks body. For instance search for "#Cris"
I have copied and modified this code from an example for Excel but it doesnt run. Runtime Error. Appreciate any assistance
Sub AdvancedSearchComplete()
Dim rsts As Outlook.Results
Dim i As Integer
Dim strF As String
Dim strS As String
strS = "Tasks"
StrName = InputBox("Search String?")
strF = InStr(LCase("urn:schemas:tasks:subject"), StrName)
Set sch = Application.AdvancedSearch(strS, strF, , "Search1")
End Sub
You need to specify a valid scope and search criteria. The scope of the search is the folder path of a folder, not a folder name. It is recommended that the folder path is enclosed within single quotes. Otherwise, the search might not return correct results if the folder path contains special characters including Unicode characters. To specify multiple folder paths, enclose each folder path in single quotes and separate the single quoted folder paths with a comma.
The Filter parameter can be any valid DASL query. For additional information on DASL queries, see Filtering Items.
Note, you can use the Chr Function to represent any character in the search criteria.
Sub TestSearchForMultipleFolders()
Dim Scope As String
Dim Filter As String
Dim MySearch As Outlook.Search
Dim MyTable As Outlook.Table
Dim nextRow As Outlook.Row
m_SearchComplete = False
'Establish scope for multiple folders
Scope = "'" & Application.Session.GetDefaultFolder( _
olFolderInbox).FolderPath _
& "','" & Application.Session.GetDefaultFolder( _
olFolderSentMail).FolderPath & "'"
'Establish filter
If Application.Session.DefaultStore.IsInstantSearchEnabled Then
Filter = Chr(34) & "urn:schemas:httpmail:subject" _
& Chr(34) & " ci_phrasematch 'Office'"
Else
Filter = Chr(34) & "urn:schemas:httpmail:subject" _
& Chr(34) & " like '%Office%'"
End If
Set MySearch = Application.AdvancedSearch(Scope, Filter, True, "MySearch")
While m_SearchComplete <> True
DoEvents
Wend
Set MyTable = MySearch.GetTable
Do Until MyTable.EndOfTable
Set nextRow = MyTable.GetNextRow()
Debug.Print nextRow("Subject")
Loop
End Sub
Also you may find the Advanced search in Outlook programmatically: C#, VB.NET article helpful.
Ok, this is what I got to work.
When starting the macro:
It Asks user to enter string
Performs and advance search and search for string in subject (including special characters like #cris)
Creates search folder to display search results
In case it helps anybody else. I don't know how to create an output like when doing a manual search. But this works for me.
Sub AdvSearchForStr()
On Error GoTo Err_SearchFolderForSender
Dim strFrom As String
Dim strTo As String
Dim strSearch As String
strSearch = InputBox("Enter String to AdvSearch", "Advanced Search")
strTo = "Test"
Dim strDASLFilter As String
strDASLFilter = "urn:schemas:httpmail:subject LIKE '%" & strSearch & "%'"
Debug.Print strDASLFilter
Dim strScope As String
strScope = "'Inbox', 'Sent Items', 'Tasks'"
Dim objSearch As Search
Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
'Save the search results to a searchfolder
objSearch.Save (strSearch)
Set objSearch = Nothing
Exit Sub
Err_SearchFolderForSender:
MsgBox "Error # " & Err & " : " & Error(Err)
End Sub

Apply Filter to Search Button in MS Access VBA

I'm having trouble getting this code to work. I have a blank form with a simple multi-select list box (GroupList) and a button underneath it (cmdSearch). I'm trying to put code into the button to pull select names from GroupList and display Group Affiliation names (field: [Group Affiliations] from table Group_Affiliations.
Private Sub cmdSearch_Click()
Dim varItem As Variant
Dim strSearch As String
Dim Task As String
For Each varItem In Me!GroupList.ItemsSelected
strSearch = strSearch & "," & Me!GroupList.ItemData(varItem)
Next varItem
MsgBox (strSearch)
If Len(strSearch) = 0 Then
Task = "select * from Group_Affiliations"
Else
strSearch = Right(strSearch, Len(strSearch) - 1)
Task = "select * from Group_Affiliations where ([Group Affiliations] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
End Sub
Please help. I think I'm close but it wants me to set a parameter and then I receive the error:
Error code 2501
I think you will likely get the results you want using the following code:
'Set strSearch to empty string
strSearch = ""
'Loop through as you did applying proper single quotes between items
For Each varItem In Me!GroupList.ItemsSelected
strSearch = strSearch & "'" & Me!GroupList.ItemData(varItem) & "',"
Next varItem
'MsgBox (strSearch) 'commented out as I'm sure this is for your testing
'checking if blank (as you did)
If Len(strSearch) = 0 Then
Task = "select * from Group_Affiliations"
'removing end comma and writing SQL statement
Else
strSearch = Left(strSearch, Len(strSearch) - 1)
Task = "select * from Group_Affiliations where ([Group Affiliations] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
If you inspect Task, you will see that the elements of the IN(... part are not quoted. As they are strings (both in VB and for the database, a text field), you must quote the components:
strSearch = strSearch & "'" & Me!GroupList.ItemData(varItem) & "',"
This worked. Thanks billyhoes and everyone! I did show the msgbox because, in this case, I do need viewers to see what they're searching.
Private Sub cmdSearch_Click()
strSearch = ""
For Each varItem In Me!GroupList.ItemsSelected
strSearch = strSearch & "'" & Me!GroupList.ItemData(varItem) & "',"
Next varItem
MsgBox (strSearch)
If Len(strSearch) = 0 Then
Task = "select * from Group_Affiliations"
Else
strSearch = Left(strSearch, Len(strSearch) - 1)
Task = "select * from Group_Affiliations where ([Group Affiliations] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
End Sub