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.
Related
I have a function that looks as such...
Dim iFileNo As Integer
Dim sLine As String
Dim sSQL_InsertPrefix As String
Dim sSQL As String
Dim vasFields As Variant
Dim iIndex As Long
iFileNo = FreeFile
'Open File
Open FileName For Input As #iFileNo
If EOF(iFileNo) Then
Exit Sub
End If
sSQL_InsertPrefix = "INSERT INTO temptable (Vendor, Invoice, Date1, Date2, HoldPayment, NetRedeemed, GlCode, ServiceName, SepCheck) VALUES ("
Do Until EOF(iFileNo)
Line Input #iFileNo, sLine
'Initialize SQL STRING
sSQL = sSQL_InsertPrefix
vasFields = Split(sLine, " , ")
For iIndex = 0 To UBound(vasFields) - 1
sSQL = sSQL & "'"
sSQL = sSQL & vasFields(iIndex)
sSQL = sSQL & "'"
sSQL = sSQL & ","
Next iIndex
sSQL = sSQL & "'"
sSQL = sSQL & vasFields(iIndex)
sSQL = sSQL & "'"
sSQL = sSQL & ")"
g_cn.Execute sSQL
Loop
Close #iFileNo
Everything looks okay as in, the file gets opened, I am able to go into the file, it recognizes the data in my .csv files in this line
Line Input #iFileNo, sLine
However, when it gets to
vasFields = Split(sline," , ")
VasFields it not being split
so when it gets to the loop :
For iIndex = 0 to Ubound(vasFields) - 1
it skips right to the end and instead hits this part
sSQL = sSQL & "'"
sSQL = sSQL & vasFields(iIndex)
sSQL = sSQL & "'"
sSQL = sSQL & ")"
So the whole VALUES part of the insert statement, only gets the single quotes in the beginning and end. Overall abbreviated insert statement looks like this..
Insert into temptable (x, y, z) Values ('123,XXX,456') <-- in which case it treats it as a single value aI believe and gives me an error that the number of insert field has to be equal to specified values
Any idea why vasFields=split(sline," , ") is not getting the values?
The problem is the literal being used in the second parameter of the split function. It's looking for exactly a space-comma-space combination. I'd take out the spaces and try this instead:
vasFields = Split(sline,",")
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
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
Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function
My form takes the data the user entered, constructs a SQL statement and returns the results. I would like to have a message box pop up when there are no matches found.
My current code/idea:
If qdf.sql = 0 Then
MsgBox "No clients matching your information." & _
vbCrLf & "have been found. Please try again." & _
, vbCritical, "No Matches"
Else
DoCmd.OpenForm "frmSearchResults"
Me.Visible = False
End If
I'm having trouble figuring out the correct syntax for if qdf.sql = 0 .
UPDATE: Full query
Private Sub cmdSearch_Click()
'On Error GoTo cmdSearch_Click_err
Dim db As Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim qdf As QueryDef
Dim strClientID As String
Dim strLastName As String
Dim strFirstName As String
Dim strDOB As String
Set db = CurrentDb
Set rs = db.OpenRecordset(qdf.sql)
' call QueryCheck module to determine if query exists
If Not QueryExists("qrySearch") Then
Set qdf = db.CreateQueryDef("qrySearch")
Else
Set qdf = db.QueryDefs("qrySearch")
End If
' handle nulls in the user's entries
If IsNull(Me.txtClientID.Value) Then
strClientID = " Like '*' "
Else
strClientID = "='" & Me.txtClientID.Value & "' "
End If
If IsNull(Me.txtLastName.Value) Then
strLastName = " Like '*' "
Else
strLastName = " Like '" & Me.txtLastName.Value & "*' "
End If
If IsNull(Me.txtFirstName.Value) Then
strFirstName = " Like '*' "
Else
strFirstName = " Like '*" & Me.txtFirstName.Value & "*' "
End If
If IsNull(Me.txtDOB.Value) Then
strDOB = " Like '*' "
Else
strDOB = "='" & Me.txtDOB.Value & "' "
End If
strSQL = "SELECT Clients.* " & _
"FROM Clients " & _
"WHERE Clients.clientid" & strClientID & _
"AND Clients.namelast" & strLastName & _
"AND Clients.namefirst" & strFirstName & _
"AND Clients.birthdate" & strDOB & _
"ORDER BY Clients.namelast,Clients.namefirst;"
Debug.Print strSQL
' check to see if the results form is open and close if it is
DoCmd.Echo False
If Application.SysCmd(acSysCmdGetObjectState, acForm, "frmSearchResults") = acObjStateOpen Then
DoCmd.Close acForm, "frmSearchResults"
End If
' run SQL statment
qdf.sql = strSQL
' check for no matches found
If rs.RecordCount = 0 Then
MsgBox "No clients matching your information were found." & _
vbCrLf & "Please search again.", vbInformation, "No Matches"
Else
DoCmd.OpenForm "frmSearchResults"
Me.Visible = False
End If
'cmdSearch_Click_exit:
' DoCmd.Echo True
' Set qdf = Nothing
' Set db = Nothing
'Exit Sub
'cmdSearch_Click_err:
' MsgBox "An unexpected error has occurred." & _
' vbCrLf & "Please note of the following details and contact the EIIS support desk:" & _
' vbCrLf & "Error Number: " & Err.Number & _
' vbCrLf & "Description: " & Err.Description _
' , vbCritical, "Error"
' Resume cmdSearch_Click_exit
End Sub
The reason that If qdf.sql = 0 then won't perform a proper check is that qdf contains the information about your query such as the SQL text that you are checking in that statement but not the results.
To get the results of the query you need to assign it to a Recordset after you have build your query. So first build your query and then assign it to the record set.
Dim db as DAO.Database
Set db = CurrentDb
Dim qdf as DAO.Querydef
Set qdf = db.CreateQueryDef("qrySearch")
Dim rs as DAO.Recordset
Set rs = CurrentDb.OpenRecordset(qdf.sql)
You can then check what your record set has returned.
If rs.RecordCount = 0 then
So where you have your line ' run SQL statment you would want to place the Set rs line.
If you have any ADO experience you can use something like
dim strSQL as String
dim conn as Connection
dim cmd as Command
dim rs as Recordset
(set up connection/command here)
cmd.commandtext = (your select query)
set rs = Command.execute
if rs.eof then
(or if rs.recordcount = 0 however returning a recordcount requires the correct cursortype - usually adOpenStatic - to be used)
'msgbox no match
else
'do stuff
If any of this is alien, then post your actual query and I'll try and give you the code in full. Good luck!