Error 3061: Too few parameters. Expected 1

N

noname

Hi,

I am getting this error dont know why. This error is cropping up while
executing last Sql statement strSQL8.



here's the code:

Option Compare Database

Sub BuildQueries()
DoCmd.SetWarnings False

Dim FromDate As Date, ToDate As Date

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL0 As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim strSQL6 As String
Dim strSQL7 As String
Dim strSQL8 As String

Set dbs = CurrentDb

FromDate = CDate(InputBox("Please enter StartDate" & vbCrLf & " in
'MM-DD-YYYY' format!", "Start Date", Int(Now) - 1))
ToDate = CDate(InputBox("Please enter EndDate" & vbCrLf & " in 'MM-
DD-YYYY' format!", "Start Date", Int((Now))))


strSQL0 = "Drop Table CheckInOutModify;"
strSQL1 = "SELECT " & "*" & " INTO CheckInOutModify FROM
CHECKINOUT WHERE CHECKTIME >= #" & FromDate & " 5:00:00" & "# And
CHECKTIME <= #" & ToDate & " 5:00:00" & "# And SENSORID Not In " &
"('9','10','11','12','13','14','15') ORDER BY USERID,CHECKTIME DESC;"
strSQL2 = "ALTER TABLE CheckInOutModify ADD COLUMN CheckDate
DateTime, BadgeNumber Text(24);"
strSQL3 = "UPDATE CheckInOutModify SET CheckType = 'X' WHERE
SENSORID In ('9','10','11','12','13','14','15');"
strSQL4 = "UPDATE checkinoutmodify SET CheckType = 'I' WHERE
SENSORID In ('1','4','5','7');"
strSQL5 = "UPDATE checkinoutmodify SET CheckType = 'O' WHERE
SENSORID In ('2','3','6','8');"
strSQL6 = "UPDATE CheckInOutModify SET CheckDate =
INT(CHECKTIME);"
strSQL7 = "UPDATE USERINFO INNER JOIN CheckInOutModify ON
USERINFO.USERID=CheckInOutModify.USERID SET
CheckInOutModify.BadgeNumber = USERINFO.BadgeNumber;"

strSQL8 = "SELECT DISTINCT BadgeNumber AS Employee_Code, ToDate AS
CDate, (SELECT MIN(CHECKTIME) from [CheckInOutModify] where
CheckType='I' and BadgeNumber=[CIOM.BadgeNumber]) AS CheckInTime,
(SELECT MAX(CHECKTIME) from [CheckInOutModify] where CheckType='O' and
BadgeNumber=[CIOM.BadgeNumber]) AS CheckOutTime, FORMAT(CheckOutTime-
CheckInTime,'hh:mm:ss') AS WorkDuration, (CheckOutTime-CheckInTime) AS
WorkDurationPt FROM CheckInOutModify AS CIOM WHERE (CheckDate =#" &
FromDate & "# Or " & "CheckDate =#" & ToDate & "#) GROUP BY
BadgeNumber,CheckDate ORDER BY BadgeNumber;"


Debug.Print strSQL8
Dim Arr(9) As String
Arr(0) = strSQL0
Arr(1) = strSQL1
Arr(2) = strSQL2
Arr(3) = strSQL3
Arr(4) = strSQL4
Arr(5) = strSQL5
Arr(6) = strSQL6
Arr(7) = strSQL7
Arr(8) = strSQL8


For i = 0 To UBound(Arr) - 2
For Each qdf In CurrentDb.QueryDefs
If qdf.Name = "Qry" Then
CurrentDb.QueryDefs.Delete (qdf.Name)
Exit For
End If
Next qdf
Set cqdf = dbs.CreateQueryDef("Qry", Arr(i))
' cqdf.Parameters

' On Error Resume Next
cqdf.Execute
' On Error GoTo 0
Next i

Dim QryName As String
Dim strPath As String
Dim strXLFile As String
Dim strTitle As String

'QryName = "Qry"
QryName = strSQL8

strXLFile = "E:\Eijaz\" & "Leela Dump - " & Format(FromDate, "dd-
mmm-yy") & " to " & Format(ToDate, "dd-mmm-yy") & ".xls"
strTitle = "Leela " & Format(FromDate, "dd-mmm-yy") & " to " &
Format(ToDate, "dd-mmm-yy")

Dim objXL As Object
Set objXL = CreateObject("Excel.Application")
objXL.Workbooks.Add
objXL.Worksheets(1).Name = strTitle
objXL.Visible = True

Dim objRS As DAO.Recordset
Dim objField As DAO.Field

Set objRS = dbs.OpenRecordset(QryName)
Dim lngRow As Long
Dim lngCol As Long

If Not objRS.EOF Then
lngRow = 1: lngCol = 1
For Each objField In objRS.Fields
objXL.Worksheets(1).Cells(lngRow, lngCol).Value =
objField.Name
lngCol = lngCol + 1
Next
lngRow = lngRow + 1
' loop through the table records
Do While Not objRS.EOF
lngCol = 1
For Each objField In objRS.Fields
objXL.Worksheets(1).Cells(lngRow, lngCol).Value =
objField.Value
lngCol = lngCol + 1
Next
lngRow = lngRow + 1
objRS.MoveNext
Loop
End If
objXL.DisplayAlerts = False
objXL.ActiveWorkbook.SaveAs strPath, 46
objXL.ActiveWorkbook.Close
Set objXL = Nothing

' DoCmd.TransferSpreadsheet transfertype:=acExport,
spreadsheettype:=acSpreadsheetTypeExcel8, tablename:=QryName,
Filename:=strXLFile, HasFieldNames:=True
' If MsgBox("Do you want to view the file?", vbYesNo) = vbYes Then
' FollowHyperlink strXLFile
' End If

DoCmd.SetWarnings True
End Sub

I dont know if i m right, but i think its to do with the 2 date
parameters (FromDate, ToDate).

any help would be appreciated.
 
P

Paolo

Hi noname,
try in this way
strSQL8 = "SELECT DISTINCT BadgeNumber AS Employee_Code, ToDate AS
CDate, (SELECT MIN(CHECKTIME) from [CheckInOutModify] where
CheckType='I' and BadgeNumber=[CIOM.BadgeNumber]) AS CheckInTime,
(SELECT MAX(CHECKTIME) from [CheckInOutModify] where CheckType='O' and
BadgeNumber=[CIOM.BadgeNumber]) AS CheckOutTime, FORMAT(CheckOutTime-
CheckInTime,'hh:mm:ss') AS WorkDuration, (CheckOutTime-CheckInTime) AS
WorkDurationPt FROM CheckInOutModify AS CIOM WHERE (CheckDate =#" &
FromDate & "# Or CheckDate =#" & ToDate & "#) GROUP BY
BadgeNumber,CheckDate ORDER BY BadgeNumber;"

HTH Paolo

noname said:
Hi,

I am getting this error dont know why. This error is cropping up while
executing last Sql statement strSQL8.



here's the code:

Option Compare Database

Sub BuildQueries()
DoCmd.SetWarnings False

Dim FromDate As Date, ToDate As Date

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL0 As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim strSQL6 As String
Dim strSQL7 As String
Dim strSQL8 As String

Set dbs = CurrentDb

FromDate = CDate(InputBox("Please enter StartDate" & vbCrLf & " in
'MM-DD-YYYY' format!", "Start Date", Int(Now) - 1))
ToDate = CDate(InputBox("Please enter EndDate" & vbCrLf & " in 'MM-
DD-YYYY' format!", "Start Date", Int((Now))))


strSQL0 = "Drop Table CheckInOutModify;"
strSQL1 = "SELECT " & "*" & " INTO CheckInOutModify FROM
CHECKINOUT WHERE CHECKTIME >= #" & FromDate & " 5:00:00" & "# And
CHECKTIME <= #" & ToDate & " 5:00:00" & "# And SENSORID Not In " &
"('9','10','11','12','13','14','15') ORDER BY USERID,CHECKTIME DESC;"
strSQL2 = "ALTER TABLE CheckInOutModify ADD COLUMN CheckDate
DateTime, BadgeNumber Text(24);"
strSQL3 = "UPDATE CheckInOutModify SET CheckType = 'X' WHERE
SENSORID In ('9','10','11','12','13','14','15');"
strSQL4 = "UPDATE checkinoutmodify SET CheckType = 'I' WHERE
SENSORID In ('1','4','5','7');"
strSQL5 = "UPDATE checkinoutmodify SET CheckType = 'O' WHERE
SENSORID In ('2','3','6','8');"
strSQL6 = "UPDATE CheckInOutModify SET CheckDate =
INT(CHECKTIME);"
strSQL7 = "UPDATE USERINFO INNER JOIN CheckInOutModify ON
USERINFO.USERID=CheckInOutModify.USERID SET
CheckInOutModify.BadgeNumber = USERINFO.BadgeNumber;"

strSQL8 = "SELECT DISTINCT BadgeNumber AS Employee_Code, ToDate AS
CDate, (SELECT MIN(CHECKTIME) from [CheckInOutModify] where
CheckType='I' and BadgeNumber=[CIOM.BadgeNumber]) AS CheckInTime,
(SELECT MAX(CHECKTIME) from [CheckInOutModify] where CheckType='O' and
BadgeNumber=[CIOM.BadgeNumber]) AS CheckOutTime, FORMAT(CheckOutTime-
CheckInTime,'hh:mm:ss') AS WorkDuration, (CheckOutTime-CheckInTime) AS
WorkDurationPt FROM CheckInOutModify AS CIOM WHERE (CheckDate =#" &
FromDate & "# Or " & "CheckDate =#" & ToDate & "#) GROUP BY
BadgeNumber,CheckDate ORDER BY BadgeNumber;"


Debug.Print strSQL8
Dim Arr(9) As String
Arr(0) = strSQL0
Arr(1) = strSQL1
Arr(2) = strSQL2
Arr(3) = strSQL3
Arr(4) = strSQL4
Arr(5) = strSQL5
Arr(6) = strSQL6
Arr(7) = strSQL7
Arr(8) = strSQL8


For i = 0 To UBound(Arr) - 2
For Each qdf In CurrentDb.QueryDefs
If qdf.Name = "Qry" Then
CurrentDb.QueryDefs.Delete (qdf.Name)
Exit For
End If
Next qdf
Set cqdf = dbs.CreateQueryDef("Qry", Arr(i))
' cqdf.Parameters

' On Error Resume Next
cqdf.Execute
' On Error GoTo 0
Next i

Dim QryName As String
Dim strPath As String
Dim strXLFile As String
Dim strTitle As String

'QryName = "Qry"
QryName = strSQL8

strXLFile = "E:\Eijaz\" & "Leela Dump - " & Format(FromDate, "dd-
mmm-yy") & " to " & Format(ToDate, "dd-mmm-yy") & ".xls"
strTitle = "Leela " & Format(FromDate, "dd-mmm-yy") & " to " &
Format(ToDate, "dd-mmm-yy")

Dim objXL As Object
Set objXL = CreateObject("Excel.Application")
objXL.Workbooks.Add
objXL.Worksheets(1).Name = strTitle
objXL.Visible = True

Dim objRS As DAO.Recordset
Dim objField As DAO.Field

Set objRS = dbs.OpenRecordset(QryName)
Dim lngRow As Long
Dim lngCol As Long

If Not objRS.EOF Then
lngRow = 1: lngCol = 1
For Each objField In objRS.Fields
objXL.Worksheets(1).Cells(lngRow, lngCol).Value =
objField.Name
lngCol = lngCol + 1
Next
lngRow = lngRow + 1
' loop through the table records
Do While Not objRS.EOF
lngCol = 1
For Each objField In objRS.Fields
objXL.Worksheets(1).Cells(lngRow, lngCol).Value =
objField.Value
lngCol = lngCol + 1
Next
lngRow = lngRow + 1
objRS.MoveNext
Loop
End If
objXL.DisplayAlerts = False
objXL.ActiveWorkbook.SaveAs strPath, 46
objXL.ActiveWorkbook.Close
Set objXL = Nothing

' DoCmd.TransferSpreadsheet transfertype:=acExport,
spreadsheettype:=acSpreadsheetTypeExcel8, tablename:=QryName,
Filename:=strXLFile, HasFieldNames:=True
' If MsgBox("Do you want to view the file?", vbYesNo) = vbYes Then
' FollowHyperlink strXLFile
' End If

DoCmd.SetWarnings True
End Sub

I dont know if i m right, but i think its to do with the 2 date
parameters (FromDate, ToDate).

any help would be appreciated.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Run-time error 3061. Too Few Parameters. Expected 2. 2
Run-time error "3061" Too few parameters. Expected 1. 4
Error 3061 - too few parameters 2
error "3061" Too few parameters 0
ERROR 3061 - Too few parameters 1
Too few parameters. Expected 1. 2
Run-time error 3061 - Too few parameters. Expected 1 5
"too few parameters expected" when filtering OpenRecordset 2

Top