Access 2007 VBA & SQL - Update a Subform pointed at a dynamically created query - sql

Abstract:
I'm using VB to recreate a query each time a user selects one of 3 options from a drop down menu, which appends the WHERE clause If they've selected anything from the combo boxes. I then am attempting to get the information displayed on the form to refresh thereby filtering what is displayed in the table based on user input.
1) Dynamically created query using VB.
Private Sub BuildQuery()
' This sub routine will redefine the subQryAllJobsQuery based on input from
' the user on the Management tab.
Dim strQryName As String
Dim strSql As String ' Main SQL SELECT statement
Dim strWhere As String ' Optional WHERE clause
Dim qryDef As DAO.QueryDef
Dim dbs As DAO.Database
strQryName = "qryAllOpenJobs"
strSql = "SELECT * FROM tblOpenJobs"
Set dbs = CurrentDb
' In case the query already exists we should deleted it
' so that we can rebuild it. The ObjectExists() function
' calls a public function in GlobalVariables module.
If ObjectExists("Query", strQryName) Then
DoCmd.DeleteObject acQuery, strQryName
End If
' Check to see if anything was selected from the Shift
' Drop down menu. If so, begin the where clause.
If Not IsNull(Me.cboShift.Value) Then
strWhere = "WHERE tblOpenJobs.[Shift] = '" & Me.cboShift.Value & "'"
End If
' Check to see if anything was selected from the Department
' drop down menu. If so, append or begin the where clause.
If Not IsNull(Me.cboDepartment.Value) Then
If IsNull(strWhere) Then
strWhere = strWhere & " AND tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
Else
strWhere = "WHERE tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
End If
End If
' Check to see if anything was selected from the Date
' field. If so, append or begin the Where clause.
If Not IsNull(Me.txtDate.Value) Then
If Not IsNull(strWhere) Then
strWhere = strWhere & " AND tblOpenJobs.[Date] = '" & Me.txtDate.Value & "'"
Else
strWhere = "WHERE tblOpenJobs.[Date] = '" & Me.txtDate.Value & "'"
End If
End If
' Concatenate the Select and the Where clause together
' unless all three parameters are null, in which case return
' just the plain select statement.
If IsNull(Me.cboShift.Value) And IsNull(Me.cboDepartment.Value) And IsNull(Me.txtDate.Value) Then
Set qryDef = dbs.CreateQueryDef(strQryName, strSql)
Else
strSql = strSql & " " & strWhere
Set qryDef = dbs.CreateQueryDef(strQryName, strSql)
End If
End Sub
2) Main Form where the user selects items from combo boxes.
picture of the main form and sub form
http://i48.tinypic.com/25pjw2a.png
3) Subform pointed at the query created in step 1.
Chain of events:
1) User selects item from drop down list on the main form.
2) Old query is deleted, new query is generated (same name).
3) Subform pointed at query does not update, but if you open the query by itself the correct results are displayed.
Name of the Query: qryAllOpenJobs
name of the subform: subQryAllOpenJobs
Also, the Row Source of subQryAllOpenJobs = qryAllOpenJobs
Name of the main form: frmManagement

I think you have your logic on the Department drop down check backwards.
You have it checking if strWhere is null, then if it is, you concatenate strWhere with the value of cboDepartment.
You should be doing what you are for Date.
' Check to see if anything was selected from the Department
' drop down menu. If so, append or begin the where clause.
If Not IsNull(Me.cboDepartment.Value) Then
If Not IsNull(strWhere) Then
strWhere = strWhere & " AND tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
Else
strWhere = "WHERE tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
End If
End If
You may also want to do:
If Nz(strWhere,"") = "" then
Instead of just doing IsNull so that you catch the zero-length string in addition to a null variable.
As for setting the recordsource, use something along the lines of
Me.sfrmJobs.Form.RecordSource = strSQL
where sfrmJobs is the name of your subform.

An empty string is not the same thing as Null. When you declare a String variable such as this:
Dim strWhere As String
strWhere is initialized as an empty string (or "zero length string"). That value is sometimes referred to as a null string, and there is even a VBA constant, vbNullString, which represents the empty string. However, regardless of which name you use, the empty string variable is not Null. Furthermore a VBA String variable can never be Null. For example, this code will cause error 94, 'Invalid use of Null':
Dim strWhere As String
strWhere = Null
The reason I am emphasizing this point is because your code tests whether strWhere is Null. That is a logic flaw because strWhere will never be Null. For example, I don't believe this condition can ever be True:
If IsNull(strWhere) Then
If you want a test to determine when strWhere has not had a value assigned to it (it's still an empty string), use the Len function:
If Len(strWhere) = 0 Then
Here is a different approach for BuildQuery. It assumes the data type for your [Date] field is String (as your original code suggests). If [Date] is actually Date/Time data type, this code will not work. Also, please note that Date is a reserved word (see Problem names and reserved words in Access). I enclosed the field name in square brackets to avoid ambiguity. If it were my own database, I would change the field name instead.
Private Sub BuildQuery()
'* Update subform RecordSource based on input from *'
'* the user on the Management tab. *'
Dim strSql As String ' Main SQL SELECT statement '
Dim strWhere As String ' Optional WHERE clause '
Dim i As Integer
Dim strControl As String
Dim strField As String
strSql = "SELECT * FROM tblOpenJobs AS oj"
strWhere = vbNullString
For i = 1 To 3
Select Case i
Case 1
strControl = "cboShift"
strField = "Shift"
Case 2
strControl = "cboDepartment"
strField = "Department"
Case 3
strControl = "txtDate"
strField = "[Date]"
End Select
If Not IsNull(Me.Controls(strControl).Value) Then
strWhere = strWhere & _
IIf(Len(strWhere) > 0, " AND ", "") & _
"oj." & strField & " = '" & _
Me.Controls(strControl).Value & "'"
End If
Next i
If Len(strWhere) > 0 Then
strSql = strSql & " WHERE " & strWhere
End If
'* use the name of the subform CONTROL for sfrmJobs *'
'* (may not be the name of the subform) *'
Me.sfrmJobs.Form.RecordSource = strSql
End Sub

My solution is below in three parts. (1) Build Query, (2) Main Form, (3) Subform.
`Private Sub OpenJobsQuery()
' This sub will construct the query on the front page for the user
' based on who they are and what they select from the combo boxes above
' the table for filtering by redefining the rowsource of the subform
' subQryOpenJobs
Dim strSql As String ' Main SQL SELECT statement
Dim strWhere As String ' Where clause containing user specified parameters.
strSql = "SELECT * FROM tblOpenJobs"
strWhere = ""
' Check to see if anything was selected from the Shift
' combo box. If so, begin the Where clause.
If Not IsNull(Me.cboOpenJobShift.Value) Then
strWhere = "WHERE tblOpenJobs.[Shift] = '" & Me.cboOpenJobShift.Value & "'"
End If
' Check to see if anything was selected from the Department
' combo box. If so, append or begin the where clause.
If Not IsNull(Me.cboOpenJobDepartment.Value) Then
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[Department] = '" & Me.cboOpenJobDepartment.Value & "'"
Else
strWhere = strWhere & " AND tblOpenJobs.[Department] = '" & Me.cboOpenJobDepartment.Value & "'"
End If
End If
' Check to see if anything was selected from the Date
' field. If so, append or begin the Where clause.
If Not IsNull(Me.cboOpenJobDate.Value) Then
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[JobDate] = #" & Me.cboOpenJobDate.Value & "#"
Else
strWhere = strWhere & " AND tblOpenJobs.[JobDate] = #" & Me.cboOpenJobDate.Value & "#"
End If
Else
' If nothing was entered in the date field, make sure the user
' only sees future jobs.
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[JobDate] > #" & FormatDateTime(Date, vbShortDate) & "#"
Else
strWhere = strWhere & " AND tblOpenJobs.[JobDate] > #" & FormatDateTime(Date, vbShortDate) & "#"
End If
End If
' Always include as part of the where clause, a section that
' will narrow the results based on who the user is
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[OpenJobID] Not In " & _
"(SELECT tblSignUps.[OpenJobID] FROM tblSignUps WHERE tblSignUps.[EUID] = '" & strEUID & "');"
Else
strWhere = strWhere & " AND tblOpenJobs.[OpenJobID] Not In " & _
"(SELECT tblSignUps.[OpenJobID] FROM tblSignUps WHERE tblSignUps.[EUID] = '" & strEUID & "');"
End If
' Concatenate the Select and the Where clause together
strSql = strSql & " " & strWhere
' Set the recordsource of the subform to the SQL query generated
' and refresh the form.
Me.subQryOpenJobs.Form.RecordSource = strSql
' In addition, synchronize the JobID's in the Edit Job box to match those
' filtered by this Build Query.
Me.cboSelectJOBID.RowSource = "SELECT tblOpenJobs.[OpenJobID] FROM tblOpenJobs" & " " & strWhere
Me.Refresh
End Sub`
(2) Main Form. http://j.imagehost.org/view/0385/Form. and (3) the subform is populated as shown in the BuildQuery() sub to construct the query based on what the user selects from the drop down filters and the input boxes on the right of the form. The data in the table itself is inaccessible to the user, this is just for them to reference.

Related

Microsoft Office Access - Median function - Too few parameters

I am trying to use this code to calculate median from my query which has these criteria:
<[Form]![testForm2]![crit1] And >[Form]![testForm2]![crit2] and <[Form]![testForm2]![Age1] And >[Form]![testForm2]![Age2]
without these criteria function works well and gives for every task median based on "MP", however when I put in there my criteria I receive error:
error - Too few parameters. Expected 4 and then it says 'Object Variable or With block not set'
my input: DMedian("MP";"testForm2";"[TASK]= '" & [TASK] & "'")
*even when the Form is open it end up with the error.
*I probably need to find a different way to filter this query from the form, but I don't know how
Public Function DMedian(FieldName As String, _
TableName As String, _
Optional Criteria As Variant) As Variant
' Created by Roger J. Carlson
' http://www.rogersaccesslibrary.com
' Terms of use: You may use this function in any application, but
' it must include this notice.
'Returns the median of a given field in a given table.
'Returns -1 if no recordset is created
' You use this function much like the built-in Domain functions
' (DLookUp, DMax, and so on). That is, you must provide the
' 1) field name, 2) table name, and 3) a 'Where' Criteria.
' When used in an aggregate query, you MUST add each field
' in the GROUP BY clause into the into the Where Criteria
' of this function.
' See Help for more on Domain Aggregate functions.
On Error GoTo Err_Median
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim RowCount As Long
Dim LowMedian As Double, HighMedian As Double
'Open a recordset on the table.
Set db = CurrentDb
strSQL = "SELECT " & FieldName & " FROM " & TableName
If Not IsMissing(Criteria) Then
strSQL = strSQL & " WHERE " & Criteria & " ORDER BY " & FieldName
Else
strSQL = strSQL & " ORDER BY " & FieldName
End If
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
'Find the number of rows in the table.
rs.MoveLast
RowCount = rs.RecordCount
rs.MoveFirst
'Determine Even or Odd
If RowCount Mod 2 = 0 Then
'There is an even number of records. Determine the low and high
'values in the middle and average them.
rs.Move Int(RowCount / 2) - 1
LowMedian = rs(FieldName)
rs.Move 1
HighMedian = rs(FieldName)
'Return Median
DMedian = (LowMedian + HighMedian) / 2
Else
'There is an odd number of records. Return the value exactly in
'the middle.
rs.Move Int(RowCount / 2)
'Return Median
DMedian = rs(FieldName)
End If
Exit_Median:
'close recordset
rs.Close
Exit Function
Err_Median:
If Err.number = 3075 Then
DMedian = 0
Resume Exit_Median
ElseIf Err.number = 3021 Then
'EOF or BOF ie no recordset created
DMedian = -1
Resume Exit_Median
Else
MsgBox Err.Description
Resume Exit_Median
End If
End Function
The parameter separation character is comma and you are using a semi-colon
CHANGE:
DMedian("MP";"testForm2";"[TASK]= '" & [TASK] & "'")
TO:
DMedian("MP", "testForm2", "[TASK]= '" & [TASK] & "'")
Solution was to refer the text boxes in SQL declaration, Thank you guys
like this:
HAVING (((Data.[REV]< " & Me.crit1 & ") And (Data.[REV])>" & Me.crit2 & ") AND ((Reg.Age)<" & Me.Age1 & " And (Reg.Age)>" & Me.Age2 & " " & SQLcritComplete & "));"
NOT like this:
"HAVING (((Data.[REV]<[Form]![testForm2]![crit1]) And (Data.[REV])>[testForm2]![crit2]) AND ((Reg.Age)<[Form]![testForm2]![Age1] And (Reg.Age)>[Form]![testForm2]![Age2] & SQLcritComplete & "));"

Using keywords to find records and list them in a listbox

I have a form (frmSearch) that I use several (4) comboboxes to filter out results for a listbox (lstCustomers). What I'm attempting to do now is create the ability to filter the listbox based on a text box of "keywords". Additionally, the column which the keyword box will search will be variable based on cboWhere which is a list of columns from tblContacts (the table qryContactWants uses)
I found a really nice Function set with the following code that will let me filter everything, but I'm not entirely sure how to turn this data around and use it to filter out my listbox.
This function organizes the keywords:
Public Function FindAnyWord(varFindIn, strWordList As String) As Boolean
Dim var
Dim aWords
aWords = Split(strWordList, ",")
For Each var In aWords
If FindWord(varFindIn, var) Then
FindAnyWord = True
Exit Function
End If
Next var
End Function
And this function actually performs the search:
Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean
Const PUNCLIST = """' .,?!:;(){}[]-—/"
Dim intPos As Integer
FindWord = False
If Not IsNull(varFindIn) And Not IsNull(varWord) Then
intPos = InStr(varFindIn, varWord)
' loop until no instances of sought substring found
Do While intPos > 0
' is it at start of string
If intPos = 1 Then
' is it whole string?
If Len(varFindIn) = Len(varWord) Then
FindWord = True
Exit Function
' is it followed by a space or punctuation mark?
ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
Else
' is it precedeed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
' is it at end of string or followed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
End If
End If
' remove characters up to end of first instance
' of sought substring before looping
varFindIn = Mid(varFindIn, intPos + 1)
intPos = InStr(varFindIn, varWord)
Loop
End If
End Function
And here is the code that I typically use to filter the listbox using the comboboxes on frmSearch:
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
What I would like to do is take the functions I found for searching keywords and apply it to my form and aid in returning a list of customers in lstCustomers
Ideally, having the keyword function return an SQL statement similar to those I'm using to filter out the listbox would be perfect. This would allow me to add a simple SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING
EDIT 1:
While using the following code, VBA is tossing a compile error on the second "End If" stating there isn't a Block If. There clearly is, so I'm not sure what's going on. Here is the code I'm using:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
If Trim(b) <> "" Then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
End If
End If
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
And under the function RequerylistCustomers() I added the If IsNull (Me.txtSearch) = False Then code below:
Private Sub RequerylstCustomers()
Dim SQL As String
'Dim criteria As String
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
Dim strWhere As String
'Grab Keywords from txtSearch using cboWhere to search for those keywords
If IsNull(Me.txtSearch) = False Then
strWhere = KeyWhere(Me.txtSearch, Me.cboWhere)
SQL = SQL & " AND " & strWhere
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
Are the keywords to be searched in a single column (say a comments or memo column?). If yes, then you should be able to optional "add" the one additional criteria to your current "set" of combo box filters.
Are we to assume that the keywords can appear anywhere in that memo column to search?
So, if there are "key words entered into that text box, then you call KeyWhere.
eg this routine:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
if trim(v) <> "" then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
end if
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
We assume each key word is separated by a comma (could be space, but comma is better).
So, if I type in the following command in debug window to test the above?
? keywhere("Generator, Water maker, Battery","Notes")
OutPut:
(Notes like '*Generator*' or Notes like '*Water maker*' or Notes like '*Battery*')
So, we just append the above results to your final SQL.
eg:
dim strWhere as string
if isnull(me.KeyWordBox) = False then
strWhere = keyWhere(me.KeyWordBox,me.cboColumnToSearch)
SQL = SQL & " AND " & strWhere
end if
so, the above converts all keywords into a valid SQL condition for the column to search. It is likely that column is some kind of notes column, but it would work for other description type field to search.

Access Split column data w semi-colon into normalize table structure

I have a table, which was pulled out of some XML data. I'm trying to do a cross reference, so I can line out a plan for organizing the data. This 1 table has a list of variables. Fields of different data types, computations, as well as dialogs. One of the columns has options. If the data type of the variable is a dialog, its options has a list of variables, separated by a semi-colon.
So the main table has a structure like so:
For the dialog records I need to look through their options column and insert records into a normalized table. For each field, in that column, I want to add a record with that dialog name, and the ID of the row in that table (I added a PK to the table). For instance, in the dialog record, Options column, there is a field in there called BusinessName TE. I need to search this main table for the PK ID of the row that has a variable name of the same. I need to put that record's ID with the name of the dialog, and insert both into a new table I set up. This will create a cross reference for me, so I can know which variables are being used by which dialogs.
I appreciate any help anyone can give. I see stuff about using a split function, arrays and looping through to get each value, but the examples I'm finding are for strings, not a column in a table.
Thanks!
Edit: Adding in the VBA code I'm working with. I attached it to a button on a form, just so I could click to run it.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [MASTER Fields].Options,[MASTER Fields].[Variable Name] FROM [MASTER Fields] WHERE ((([MASTER Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray) + 1
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
FieldName = DLookup("ID", "MASTER Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
End If
Next i
End If
rs.MoveNext
Loop
End Sub
right now on the line that says
If TestArray(i) <> "" Then
creates an error ""
If anyone can help, I'd really appreciate it!
Another Edit:
Parfait figured out my issue. I'm posting the final code I am using, in case it helps someone else! p.s. I added a condition to check if the dlookup is successful, and trap failures in a failures table. That way I can check those out afterward.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [Master Fields].Options,[Master Fields].[Variable Name] FROM [Master Fields] WHERE ((([Master Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray)
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
If Not (IsNull(DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'"))) Then
FieldName = DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
'MsgBox "Adding ID = " & FieldName & "for Dialog: " & Dialog & "Now"
Else
insertSQL = "INSERT INTO tblFieldsNotFound(Dialog, FieldNotFound) " _
& "VALUES(""" & Dialog & """, """ & arrayVal & """)"
DoCmd.RunSQL (insertSQL)
End If
End If
Next i
End If
rs.MoveNext
Loop
MsgBox "All Done!"
End Sub

Parameter error when using VB Concatenate function

I'm using the following VBA from a friend that works quite well for concatenating items in MS Access.
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
'Purpose: Generate a concatenated string of related records.
'Return: String variant, or Null if no matches.
'Arguments: strField = name of field to get results from and concatenate.
' strTable = name of a table or query.
' strWhere = WHERE clause to choose the right values.
' strOrderBy = ORDER BY clause, for sorting the values.
' strSeparator = characters to use between the concatenated values.
'Notes: 1. Use square brackets around field/table names with spaces or odd characters.
' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
' 4. Returning more than 255 characters to a recordset triggers this Access bug:
' http://allenbrowne.com/bug-16.html
Dim rs As DAO.Recordset 'Related records
Dim rsMV As DAO.Recordset 'Multi-valued field recordset
Dim strSql As String 'SQL statement
Dim strOut As String 'Output string to concatenate to.
Dim lngLen As Long 'Length of string.
Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.
'Initialize to Null'
ConcatRelated = Null
'Build SQL string, and get the records.
strSql = "SELECT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSql = strSql & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSql = strSql & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
'Determine if the requested field is multi-valued (Type is above 100.)
bIsMultiValue = (rs(0).Type > 100)
'Loop through the matching records
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
'Return the string without the trailing separator.
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
'Clean up
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
I call this function successfully from the following query:
INSERT INTO tblData ( SubjectNumber, RECDATE, RecordedDoses, DoseTimes, FoodType, ProgrammingComments )
SELECT d.SubjectNumber, d.RECDATE, Count(d.RECTIME) AS RecordedDoses, ConcatRelated("RECTIME", "qryDump2", "SubjectNumber= """ & d.[SubjectNumber] & """" & " AND RECDATE=" & FORMAT(d.RECDATE, "\#yyyy-m-d\#")) AS DoseTimes, ConcatRelated("FoodType", "qryDump2", "SubjectNumber= """ & d.[SubjectNumber] & """" & " AND RECDATE=" & FORMAT(d.RECDATE, "\#yyyy-m-d\#")) AS FoodType, d.Visit AS ProgrammingComments
FROM qryDump2 AS d
GROUP BY d.SubjectNumber, d.RECDATE, d.Visit
HAVING Count(d.RECTIME)<2 Or Count(d.RECTIME)>2
ORDER BY d.RECDATE;
The query above references several tables and queries. The issue is, when my criteria is a specific subject, e.g. "1011002", the concatenate function has no problem running. However, when the criteria is anything else, e.g. Prompt criteria, referencing a text box, etc, I get the fun "Error 3061: Too few parameters. Expected 1. If I switch my criteria back to a string, e.g. "1011002" it works again. When using prompt criteria, if I type the same item in, i.e. 1011002, the error appears again.
What am I missing?
Edit: The query that is called a few items down the line that references the criteria I mentioned above is as follows:
SELECT tblDump.SubjectNumber, IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1) AS RECDATE, IIf(tblDump.DRUG_Q1=1,tblDump.RECTIME,tblDump.DRUG_Q6) AS RECTIME, tblDump.FoodType, IIf(IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1)=tblL.DiscontDate,"DayOfDiscontinuation",IIf(IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1)=tblL.CompletionDate,"CompletionDate",IIf(IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1)=tblL.[2],"Visit2"))) AS Visit
FROM tblDump LEFT JOIN tblL ON tblDump.SubjectNumber = tblL.SubjectNumber
WHERE tblDump.SubjectNumber=Forms![frm]![test];
The where statement, when I use an actual value, e.g. "1011002" (subject number is text and not a number even though the example I gave is a number), the concatenate function works. When I use what is above, i.e. referencing a form field, I get the aforementioned error.
The where clause isn't checking to see if the text has spaces, maybe trim the form data before putting it into the function call and see if that stops your code from creating an empty where clause in the sql.

Ms-Access how to use a query with a parameter inside a form

I have an SQL query with a question(alert like) that pops up every time I open it...
For every value inserted in that question you get diffrent result.
I Want to be able to use that query in my form with a combo-box...
I don't know how to exceute the query with the parameter from within the form....
I have no problem using VBA, just tell me how to call the query with the parameter
Thanks,
Fingerman
I usually use my filtering forms using the following principles:
1) I first create a query that includes all the fields I want to display and all the fields I want to filter on. It can use more than one table. I do not set any criteria (WHERE clause) in this query unless there is a condition that always needs to be applied no matter what.
2) Next I create a datasheet form based on this query and I save it, giving it a name that indicates that it's a subform.
3) Next I create an unbound main form and add unbound controls such as textboxes, combos, listboxes, checkboxes, etc. that will be used to filter the different fields. One control can potentially allow a user to search on more than one field depending how you write your filtering routine in VBA.
4) Now it's time to write code on the main form to make this all work. Basically, the code needs to check to see if there are values in any of the controls and if so, it creates a WHERE clause (without the WHERE keyword) and at the very end it sets the subform's filter property and turns the subform's FilterOn property to TRUE.
Here's some example code. This was taken from the sample database I've made just to demonstrate filtering (see below). This example does not use fuzzy searches (asterisks) and each control on the main form only filters one field on the subform.
Private Sub cmdFilter_Click()
'You can also call the FilterSubForm function on a control's AfterUpdate event.
Call FilterSubform
End Sub
Private Sub FilterSubform()
Dim strFilter As String
'Note: We have to wrap field names in brackets if they contain spaces or
'special characters. These fields are in Northwind Traders 2007 from Microsoft
'I would never consider naming my fields with spaces or special characters
'in them.
'Company
If Nz(Me.txtCompany, "") <> "" Then
strFilter = strFilter & "Company = '" & PQ(Me.txtCompany) & "' And "
End If
'First Name
If Nz(Me.txtFirstName, "") <> "" Then
strFilter = strFilter & "[First Name] = '" & PQ(Me.txtFirstName) & "' AND "
End If
'Last Name
If Nz(Me.txtLastName, "") <> "" Then
strFilter = strFilter & "[Last Name] = '" & PQ(Me.txtLastName) & "' AND "
End If
'Business Phone
If Nz(Me.txtBusinessPhone, "") <> "" Then
strFilter = strFilter & "[Business Phone] = '" & PQ(Me.txtBusinessPhone) & "' AND "
End If
'City
If Nz(Me.cboCity, "") <> "" Then
strFilter = strFilter & "City = '" & PQ(Me.cboCity) & "' AND "
End If
'State/Province
If Nz(Me.cboStateProvince, "") <> "" Then
strFilter = strFilter & "[State/Province] = '" & PQ(Me.cboStateProvince) & "' AND "
End If
'Order Date
If Nz(Me.txtOrderDate, "") <> "" Then
If IsDate(Me.txtOrderDate) = True Then
strFilter = strFilter & "[Order Date] = #" & Me.txtOrderDate & "# AND "
End If
End If
'Ship Name
If Nz(Me.txtShipName, "") <> "" Then
strFilter = strFilter & "[Ship Name] = '" & PQ(Me.txtShipName) & "' AND "
End If
'Ship City
If Nz(Me.txtShipCity, "") <> "" Then
strFilter = strFilter & "[Ship City] = '" & PQ(Me.txtShipCity) & "' AND "
End If
'Ship State/Province
If Nz(Me.cboShipStateProvince, "") <> "" Then
strFilter = strFilter & "[Ship State/Province] = '" & PQ(Me.cboShipStateProvince) & "' AND "
End If
'Product Code
If Nz(Me.cboProductCode, "") <> "" Then
strFilter = strFilter & "[Product Code] = '" & PQ(Me.cboProductCode) & "' AND "
End If
'Quantity
If Nz(Me.txtQuantity, "") <> "" Then
If IsNumeric(Me.txtQuantity) = True Then
strFilter = strFilter & "Quantity = " & Me.txtQuantity & " AND "
End If
End If
If Right(strFilter, 5) = " AND " Then strFilter = Left(strFilter, Len(strFilter) - 5)
If strFilter <> "" Then
Me.subformOrderSearch.Form.Filter = strFilter
Me.subformOrderSearch.Form.FilterOn = True
Else
'Clear the filter
Me.subformOrderSearch.Form.Filter = ""
Me.subformOrderSearch.Form.FilterOn = False
End If
End Sub
Private Function PQ(s As String) As String
'This function is used to "pad quotes" for SQL
PQ = Replace(s, "'", "''")
End Function
I've put together a sample database that has several different examples all building on what I've posted here. You can download this database here:
http://www.utteraccess.com/forum/Search-filtering-Examples-t1968063.html
After some Searching, I have came across this:
http://www.techrepublic.com/blog/msoffice/run-a-parameter-query-within-an-access-form/701
It is not what I wanted, But it is a great solution...
I will wait, if no one gets a better answer, I'll accept my own (As much as I hate doing that).