I am trying to use a ComboBox to append a query through a form I built. The Combobox should be optional, but I can't seem to get around the Invalid use of null error. Here is the code I have currently
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim Box1 As String
Dim strBox1 As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Set MyDB = CurrentDb()
'General SQL Code
strSQL = "SELECT * FROM Test1"
'Build the IN string by looping through the listbox
For i = 0 To List6.ListCount - 1
If List6.Selected(i) Then
If List6.Column(0, i) = "_All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & List6.Column(0, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [Test1.Brand_Name] in " & _
"(" & Left(strIN, Len(strIN) - 1) & ")"
'Create the AND string
Box1 = Me.Combo8.Value
If IsNull(Me.Combo8.Value) Then
strBox1 = Nz(Me.Combo8.Column(0), "")
Else: strBox1 = " AND [Test1.Population] = '" & Box1 & "'"
End If
If Not flgSelectAll Then
strSQL = strSQL & strWhere & strBox1
End If
MyDB.QueryDefs.Delete "cpwg"
Set qdef = MyDB.CreateQueryDef("cpwg", strSQL)
'Open the query, built using the IN clause to set the criteria
DoCmd.OpenQuery "cpwg", acViewNormal
I have also tried
If IsNull(Box1) Or Box1 = "Null" Then
strBox1 = Nz(Me.Combo8.Column(0), "")
Else: strBox1 = " AND [Test1.Population] = '" & Box1 & "'"
End If
Try:
if isnull(me.combo8) then
Also, I Dont know how your combobox is populated, But Null is different than no data. Perhaps try
if me.combo8.value = "" then
IF IsNull(Trim(me.combo8)) Then
'Do Stuff
End if
Related
I have a MultiSelect List Box that I'm trying to use as criteria in a query. I'm fine until the line of code "qdf.SQL = strSQL" at which point I receive the error code 3131. If I place a message box just after the "strSQL =" command, it appears to populate with the correct data.
I am pulling from a list of Categories on a form (Forms("frmMain").listCat1).
What am I doing wrong? Thank you in advance.
Private Sub CAT1_Criteria()
Dim varItem As Variant
Dim strCAT1 As String
Dim ctl As Control
Dim strSQL As String
Dim db As Database
Dim qdf As QueryDef
Set ctl = Forms("frmMain").listCat1
For Each varItem In ctl.ItemsSelected
strCAT1 = strCAT1 & ",'" & ctl.ItemData(varItem) _
& "'"
Next varItem
If Len(strCAT1) = 0 Then
strCAT1 = "Like '*'"
Else
strCAT1 = Right(strCAT1, Len(strCAT1) - 1)
strCAT1 = "IN(" & strCAT1 & ")"
End If
strSQL = "SELECT dbo_CATEGORY1.* FROM dbo_CATEGORY1" & _
"WHERE dbo_CATEGORY1.[LEVEL1] " & strCAT1 & ";"
Set db = CurrentDb
Set qdf = db.QueryDefs("qryCAT1_Sel")
qdf.SQL = strSQL
'Set qdf = Nothing
'Set db = Nothing
DoCmd.OpenQuery "qryCAT1_Sel"
End Sub
Number of query values and destination fields are not the same.
Debug redirects me to this line: dbs.Execute strSQL, dbFailOnError
Here is my code:
Public Function GetMatches(Column1 As String, Column2 As String)
Dim dbs As DAO.Database
Dim rcrdStColumn1 As Recordset
Dim rcrdStColumn2 As Recordset
Dim defaultTable1 As String
Dim defaultTable2 As String
Dim strSQL As String
Dim strSQLColumn1 As String
Dim strSQLColumn2 As String
Dim firstCurrentValue As String
Dim secondCurrentValue As String
Dim currentResultComparison As Double
Dim maxResultComparison As Double
Dim checkColumn1 As Boolean
Dim checkColumn2 As Boolean
Set dbs = CurrentDb
defaultTable1 = "CEE_Names_for_CUST_DES"
defaultTable2 = "GSNDG_Names"
'Check if column exists in table 1
checkColumn1 = checkColumn(Column1, defaultTable1)
checkColumn2 = checkColumn(Column2, defaultTable2)
If checkColumn1 = False Then
MsgBox ("Column 1 does not exist")
ElseIf checkColumn2 = False Then
MsgBox ("Column 2 does not exist")
Else
strSQLColumn1 = "SELECT " & Column1 & " FROM " & defaultTable1 & " ;"
Set rcrdStColumn1 = dbs.OpenRecordset(strSQLColumn1)
strSQLColumn2 = "SELECT " & Column2 & " FROM " & defaultTable2 & " ;"
Do While Not rcrdStColumn1.EOF
firstCurrentValue = rcrdStColumn1.Fields(Column1)
maxResultComparison = 0
Set rcrdStColumn2 = dbs.OpenRecordset(strSQLColumn2)
Do While Not rcrdStColumn2.EOF
secondCurrentValue = rcrdStColumn2.Fields(Column2)
currentResultComparison = modSimil.Simil(firstCurrentValue, secondCurrentValue)
strSQL = "INSERT INTO results(Column1, Column2, Similarities)" _
& " VALUES( '" & clearString(firstCurrentValue) & "', '" & clearString(secondCurrentValue) & "', " & Round(currentResultComparison, 2) & " )"
dbs.Execute strSQL, dbFailOnError
If currentResultComparison > maxResultComparison Then
maxResultComparison = currentResultComparison
End If
rcrdStColumn2.MoveNext
Loop
rcrdStColumn1.MoveNext
Loop
End If
dbs.Close
Set dbs = Nothing
End Function
Function checkColumn(strColumn As String, strTable As String) As Boolean
On Error GoTo checkColumnError
If (DCount(strColumn, strTable) = 0) Then
checkColumn = False
Else
checkColumn = True
End If
checkColumnError:
If Err.Number = 2741 Then
MsgBox ("2741")
ElseIf checkColumn Then
checkColumn = True
Else
checkColumn = False
End If
End Function
Function clearResult()
Dim dbs As DAO.Database
Dim strSQL As String
Set dbs = CurrentDb
strSQL = "DELETE FROM results"
dbs.Execute strSQL, dbFailOnError
dbs.Close
Set dbs = Nothing
End Function
Function clearString(str As String) As String
clearString = Replace(str, "'", "")
End Function
I have three listboxes and a date range on a parameter form. I am able to pass all of the Listbox selections with no problem. I cannot seem to find a way or answer to adding a date range to the where clause.
The Date field is Course_Date, and the textbox control names for the dates are Start_Date and End_Date
Option Compare Database
Option Explicit
Private Sub cmdPreviewReports_Click()
On Error GoTo cmdPreviewReports_Err
Dim blnQueryExists As Boolean
Dim cat As New ADOX.Catalog
Dim cmd As New ADODB.Command
Dim qry As ADOX.View
Dim varItem As Variant
Dim strInstructors As String
Dim strCourseType As String
Dim strCourseTypeCondition As String
Dim strRoleType As String
Dim strRoleTypeCondition As String
Dim strCourse_Date As Date
Dim strDateRange As String
Dim strSql As String
' Check for the existence of the stored query
blnQueryExists = False
Set cat.ActiveConnection = CurrentProject.Connection
For Each qry In cat.Views
If qry.Name = "q_Parameter_Form" 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 q_jt_MCR_Instructor_Roles"
cat.Views.Append "q_Parameter_Form", cmd
End If
Application.RefreshDatabaseWindow
' Turn off screen updating
DoCmd.Echo False
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "q_Parameter_Form") = acObjStateOpen Then
DoCmd.Close acQuery, "q_Parameter_Form"
End If
' Build criteria string for Instructors
For Each varItem In Me.lst_Instructors.ItemsSelected
strInstructors = strInstructors & "," & Me.lst_Instructors.ItemData(varItem) & ""
Next varItem
If Len(strInstructors) = 0 Then
strInstructors = "Like '*'"
Else
strInstructors = Right(strInstructors, Len(strInstructors) - 1)
strInstructors = "IN(" & strInstructors & ")"
End If
' Build criteria string for CourseType
For Each varItem In Me.lst_Course_Type.ItemsSelected
strCourseType = strCourseType & "," & Me.lst_Course_Type.ItemData(varItem) & ""
Next varItem
If Len(strCourseType) = 0 Then
strCourseType = "Like '*'"
Else
strCourseType = Right(strCourseType, Len(strCourseType) - 1)
strCourseType = "IN(" & strCourseType & ")"
End If
' Get CourseType condition
If Me.optAndCourseType.Value = True Then
strCourseTypeCondition = " AND "
Else
strCourseTypeCondition = " OR "
End If
' Build criteria string for RoleType
For Each varItem In Me.lst_Role.ItemsSelected
strRoleType = strRoleType & "," & Me.lst_Role.ItemData(varItem) & ""
Next varItem
If Len(strRoleType) = 0 Then
strRoleType = "Like '*'"
Else
strRoleType = Right(strRoleType, Len(strRoleType) - 1)
strRoleType = "IN(" & strRoleType & ")"
End If
' Get RoleType condition
If Me.optAndRoleType.Value = True Then
strRoleTypeCondition = " AND "
Else
strRoleTypeCondition = " OR "
End If
'Build Criteria String for Course_Date
strDateRange = strSql And " Between Me.[Start_Date] AND Me.[End_Date]"
' Build SQL statement
strSql = "SELECT q_jt_MCR_Instructor_Roles.* FROM q_jt_MCR_Instructor_Roles " & _
"WHERE q_jt_MCR_Instructor_Roles.[InstructorID] " & strInstructors & _
strCourseTypeCondition & "q_jt_MCR_Instructor_Roles.[Course_TypesID] " & strCourseType & _
strRoleTypeCondition & "q_jt_MCR_Instructor_Roles.[Roles_ID] " & strRoleType & ";"
' Apply the SQL statement to the stored query
cat.ActiveConnection = CurrentProject.Connection
Set cmd = cat.Views("q_Parameter_Form").Command
cmd.CommandText = strSql
Set cat.Views("q_Parameter_Form").Command = cmd
Set cat = Nothing
' Open the Query
If Not IsNull(cboReports) And cboReports <> "" Then
DoCmd.OpenReport cboReports, acViewPreview ' use acNormal to print without preview
Else
MsgBox ("Please make a Label selection first from the dropdown list to the left.")
cboReports.SetFocus
End If
cboReports = ""
' If required the dialog can be closed at this point
' DoCmd.Close acForm, Me.Name
'Restore screen updating
cmdPreviewReports_Exit:
DoCmd.Echo True
Exit Sub
cmdPreviewReports_Err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description:" & Err.Description _
, vbCritical, "Error"
Resume cmdPreviewReports_Exit
End Sub
I am also able to provide the database to look at if you wish?
Thank you for helping !!!!!!
William
It could be:
'Build Criteria String for Course_Date.
strDateRange = " And Course_Date Between #" & Format(Me![Start_Date].Value, "yyyy\/mm\/dd") & "# AND #" & Format(Me![End_Date].Value, "yyyy\/mm\/dd") & "#"
strSql = strSql & strDateRange
Help! i am having some trouble with my access codes on a database whereby it says that access error 3061 Too Few parameters expected 1. Problem highlighted was
Set oRS = CurrentDb.OpenRecordset(sSQL)
Dim i As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
Dim db As DAO.Database
Set db = CurrentDb
Dim BookedDate As Date
Dim FacilitiesID As String
Dim StartTime As Date
cboTime.RowSourceType = "Value List"
cboTime.RowSource = ""
If IsNull(Start) Then Exit Sub Else i = Start
If Me.NewRecord = True Then
DoCmd.RunCommand acCmdSaveRecord
End If
sSQL = "SELECT FacilitiesID, StartTime, BookedDate"
sSQL = sSQL & " FROM qrysubform"
sSQL = sSQL & " WHERE FacilitiesID= " & Me.FacilitiesID & _
" AND BookedDate=# " & Me.txtDate & "#"
Set oRS = CurrentDb.OpenRecordset(sSQL)
Your Facilities ID is dimensioned as a string, though in your SQL statement it is referenced as a number. If your form's FacilitiesID is in fact a string, you need to enclose it in quotes:
sSQL = "SELECT FacilitiesID, StartTime, BookedDate"
sSQL = sSQL & " FROM qrysubform"
sSQL = sSQL & " WHERE FacilitiesID= '" & Me.FacilitiesID & _
"' AND BookedDate=#" & Me.txtDate & "#"
In such cases, insert a debug line and study the output:
Debug.Print sSQL
' Study output
Set oRS = CurrentDb.OpenRecordset(sSQL)
That said, this error is typically caused by a missing or misspelled field name.
I have the following code:
Public Function BuildSQL(stQueryName As String, stWhereClause As String) As String
On Error GoTo Err_BuildSQL
Dim SQLcmd As String
Dim intPos As Integer
Dim db As Database
Dim qryOrig As QueryDef
Set db = CurrentDb()
Set qryOrig = db.QueryDefs(stQueryName)
SQLcmd = qryOrig.SQL
intPos = InStr(SQLcmd, "WHERE")
If intPos > 0 Then
SQLcmd = Left(SQLcmd, intPos - 1)
End If
intPos = InStr(SQLcmd, ";")
If intPos > 0 Then
SQLcmd = Left(SQLcmd, intPos - 1)
End If
If Not (stWhereClause = "") Then
SQLcmd = Trim(SQLcmd) & " WHERE " & stWhereClause & ";"
Else
SQLcmd = Trim(SQLcmd) & ";"
End If
BuildSQL = SQLcmd
Exit_BuildSQL:
Set qryOrig = Nothing
Set db = Nothing
Exit Function
Err_BuildSQL:
MsgBox Err.Description
Resume Exit_BuildSQL
End Function
Private Sub SandBox_Click()
On Error GoTo Err_SandBox_Click
Dim db As Database
Dim rs As Recordset
Dim stSQL As String
Dim stFrmName As String
Dim stQryName As String
Dim stSQLWhere As String
Dim stIDList As String
stFrmName = "Libri"
stQryName = "Libri_All_Query"
'Define WHERE clause
stSQLWhere = ""
If Not (IsNull([Forms]![Libreria]![Editore]) Or [Forms]![Libreria]![Editore] = "") Then
stSQLWhere = stSQLWhere & "Libri_Editori.Editore = '" & [Forms]![Libreria]![Editore] & "'"
End If
If Not (IsNull([Forms]![Libreria]![CognomeAutore]) Or [Forms]![Libreria]![CognomeAutore] = "") Then
If (stSQLWhere = "") Then
stSQLWhere = stSQLWhere & "Autori.Cognome = '" & [Forms]![Libreria]![CognomeAutore] & "'"
Else
stSQLWhere = stSQLWhere & " AND Autori.Cognome = '" & [Forms]![Libreria]![CognomeAutore] & "'"
End If
End If
'Here several more fields of the search form will be checked and added
stSQL = BuildSQL(stQryName, stSQLWhere)
'*** Code in question!
Set db = CurrentDb()
Set rs = db.OpenRecordset(stSQL)
If Not (rs.EOF And rs.BOF) Then
stIDList = "("
rs.MoveFirst
Do Until rs.EOF = True
If (stIDList = "(") Then
stIDList = stIDList & rs.Fields(0)
Else
stIDList = stIDList & ", " & rs.Fields(0)
End If
rs.MoveNext
Loop
stIDList = stIDList & ")"
Else
Err.Description = "Errore! Recordset vuoto."
Resume Err_SandBox_Click
End If
DoCmd.OpenForm stFrmName, , , , acFormReadOnly
Access.Forms(stFrmName).RecordSource = "SELECT * FROM Libri WHERE Libri.ID IN " & stIDList
'**** End code in question
Exit_SandBox_Click:
Set db = Nothing
Set rs = Nothing
Exit Sub
Err_SandBox_Click:
MsgBox Err.Description
Resume Exit_SandBox_Click
End Sub
This code works as I want but "looks" slow even with a test DB with only a few records in each table.
I believe the time is spent (how can I check if this is true?) in the loop between comments.
Is there a more basic, obvious and efficient way to filter the form than creating a recordset and looping through it as I am doing?
The form "Libri" is a big one with several subform to be able to see all the data of a Book.
The query "Libri_All_Query" is a join of almost all tables in the DB and the code shown is executed from a form where I plan to add all possible search fields.
Forms have a filter property:
stWhereClause = "Title Like '" & Me.txtSearch & "*'"
Me.Filter = stWhereClause
Me.FilterOn = True
The filter should be constructed in a similar way to a WHERE statement. There are some limitations compared with Where. You may wish to check with DCount that records will be returned.
EDIT
If you want a set of records where a subform contains only certain records, you need something on these lines:
SELECT b.Title
FROM Books b
WHERE b.ID IN (
SELECT j.BookID FROM BooksAuthorJunction j
INNER JOIN Authors a ON j.AuthorID = a.ID
WHERE a.Author Like "Arn*")
There are advantages in building more that one form, books as a main form and authors as a subform, then authors as a main form and books as a subform. It is often easier on the user.