Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Access Macro and Run-Time Error 3061 Error 1

Status
Not open for further replies.

kc27

Technical User
Sep 10, 2008
171
US
This macro has worked flawlessly, then this week it displayed "Run-time error 3061. Too few parameters. Expected 1" I understand this error indicates that this may indicate a field name problem. I have not changed anything on my end, but would like to figure out what needs to be changed.

The last line in the code excerpt below is the one that is highlighted when I click on the VBA error debug button.

I did attempt using a debug method that involves adding the code shown immediately below, then running the macro. The "debug" code is inserted above the line of code that gets highlighted by the debugger. I then save and run the macro, and the debug code is supposed to display the problematic field in the code editor's Immediate Window. What I see in the Immediate Window is SQLC, Not sure what that is telling me, or if I am troubleshooting incorrectly. Any advice or guidance would be appreciated.

Dim sSQL As String
sSQL = "SQLC,"
Debug.Print sSQL
Set RSC = DBC.OpenRecordset(sSQL, dbOpenDynaset)


Code:
Option Compare Database

Public Const DB_IMG1 = "P:\Access\Shared\IMG1.MDB"
Public Const DB_CLASS = "I:\sysfiles\mg_data\DCdata.MDB"
Public Const DB_IMGM = "I:\sysfiles\mg_data\IMGM.MDB"
'Public Const DB_CLASS = "P:\Access\Shared\DCdata.MDB"

Function ClassWeeklyUpdate()
    Dim DBI As DAO.Database
    Dim RSD As DAO.Recordset
'determine correc5t fields based on run date
    Set DBI = OpenDatabase(DB_IMG1)
    Set RSD = DBI.OpenRecordset("CntlDate", dbOpenDynaset)
    Do While Date - 2 > RSD!EOMDate: RSD.MoveNext: Loop
    DAOFLD = RSD!dbField.Value
    SQLFLD = UCase(Format(Mid(DAOFLD, 2, 2) & "/" & Mid(DAOFLD, 4, 2), "mmm"))
    RSD.Close: Set RSD = Nothing
    DBI.Close: Set DBI = Nothing
'replace the class table in IMG1
    RefreshClassTable
'post current class.store sales in DCData.MDB
    PostClassSales SQLFLD, DAOFLD, "[dbo.ACLTY_CPH]" '[dbo.ACLTY_CPH]
'post current dept.store sales in DCData.MDB
    PostDeptSales SQLFLD, DAOFLD, "[dbo.ACTTY_CPH]" '[dbo.ACTTY_CPH]
'convert nulls to zero in the above two tables
    'NullsToZero
End Function

Sub MAnualUpdate()
'post current dept.store sales in DCData.MDB
    'PostDeptSales "JUN", "P0614", "[dbo.ACTLY_CPH]" '[dbo.ACTTY_CPH]
'post current class.store sales in DCData.MDB
    PostClassSales "JUN", "P0614", "[dbo.ACLTY_CPH]" '[dbo.ACLTY_CPH]

End Sub

Public Sub RefreshClassTable()
    Dim DBSS As DAO.Database
    Dim DBI As DAO.Database
    Dim RSSC As DAO.Recordset, RSC As DAO.Recordset
    Dim QuerySTR As String
    Dim TDC As DAO.TableDef, IXC As DAO.Index
    'Set DBSS = OpenDatabase("SQL_MISL_BT.dsn", dbDriverNoPrompt, True, "ODBC; DRIVER={SQL SERVER};SERVER=mmm.sqldb.prod.bntn.com;DATABASE=production")
    'Set DBSS = OpenDatabase("SQL_MISL_BT.dsn", dbDriverNoPrompt, True, "ODBC; DRIVER={SQL SERVER};SERVER=mmm.sqldb.prod.bntn.com;DATABASE=production")
    Set DBSS = OpenDatabase("SQL_MISL_BT.dsn", dbDriverNoPrompt, True, "DRIVER={SQL SERVER};SERVER=mmm.sqldb.prod.bntn.com;DATABASE=production")
'update the class table in IMGM
    Set DBI = OpenDatabase(DB_IMGM)
    DBI.Execute "DELETE * FROM ClassTable"
    SQL1 = "SELECT Dept_Code, Class_Code, Class_Name FROM [dbo.CLS_INC] ORDER BY Dept_Code, Class_Code"
    Set RSSC = DBSS.OpenRecordset(SQL1, dbOpenSnapshot)
    Set RSC = DBI.OpenRecordset("ClassTable", dbOpenDynaset)
    Do Until RSSC.EOF
        RSC.AddNew
            RSC!Dept = Format(RSSC!Dept_Code, "000")
            RSC!Class = Format(RSSC!Class_Code, "000")
            RSC!ClassDesc = RSSC!Class_Name
            RSC!Dpt_CDE = RSSC!Dept_Code
            RSC!Class_CDE = RSSC!Class_Code
        RSC.Update
        RSSC.MoveNext
    Loop
    RSC.Close: Set RSC = Nothing
    DBI.Close: Set DBI = Nothing
'update the class table in IMG1
    Set DBI = OpenDatabase(DB_IMG1)
    DBI.Execute "DELETE * FROM ClassTable"
    Set RSC = DBI.OpenRecordset("ClassTable", dbOpenDynaset)
    RSSC.MoveFirst
    Do Until RSSC.EOF
        RSC.AddNew
            RSC!Dept = Format(RSSC!Dept_Code, "000")
            RSC!Class = Format(RSSC!Class_Code, "000")
            RSC!ClassDesc = RSSC!Class_Name
            RSC!Dpt_CDE = RSSC!Dept_Code
            RSC!Class_CDE = RSSC!Class_Code
        RSC.Update
        RSSC.MoveNext
    Loop
    RSC.Close: Set RSC = Nothing
    DBI.Close: Set DBI = Nothing
    RSSC.Close: Set RSSC = Nothing
    DBSS.Close: Set DBSS = Nothing
End Sub

Sub PostClassSales(ByVal SQLFLD As String, ByVal DAOFLD As String, ByVal SQLTBL As String)
    Dim DBSS As DAO.Database
    Dim DBC As DAO.Database
    Dim RSD As DAO.Recordset
    Dim RSC As DAO.Recordset
    Dim RSS As DAO.Recordset
'---------------------------------
    Set DBC = OpenDatabase(DB_CLASS)
    Set DBSS = OpenDatabase("SQL_MISL_BT.dsn", dbDriverNoPrompt, True, "DRIVER={SQL SERVER};SERVER=mmm.sqldb.prod.bntn.com;DATABASE=production")
    Set RSD = DBC.OpenRecordset("SELECT Dept FROM [Dept Table] ORDER BY Dept", dbOpenDynaset)
    Do Until RSD.EOF
        SysCmd acSysCmdSetStatus, "Posting to dept " & RSD!Dept
        sqlss = "SELECT DEPT_CODE, CLASS_CODE, STORE_CODE, " & SQLFLD & " " & _
                "FROM " & SQLTBL & " " & _
                "WHERE ((ELE_CODE = 8) AND (DEPT_CODE =" & Val(RSD!Dept) & ")) "
        Set RSS = DBSS.OpenRecordset(sqlss, dbOpenSnapshot)
        SQLC = "SELECT DCL, Store, " & DAOFLD & " FROM SalesFCL WHERE DCL LIKE '" & RSD!Dept & "*' ORDER BY DCL, Store"
        Set RSC = DBC.OpenRecordset(SQLC, dbOpenDynaset)
 
When something has run well before and now doesn't I would look at the data. If the problem is SQLC then try this code to write the SQLC to the immediate window:

Code:
Set RSS = DBSS.OpenRecordset(sqlss, dbOpenSnapshot)
        SQLC = "SELECT DCL, Store, " & DAOFLD & " FROM SalesFCL WHERE DCL LIKE '" & RSD!Dept & "*' ORDER BY DCL, Store"
        debug.print SQLC   [COLOR=#4E9A06]'add this line for debugging[/color]
        Set RSC = DBC.OpenRecordset(SQLC, dbOpenDynaset)

I expect the value for RSD!Dept contains a single quote.

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016
 
Thank you dhookom! Your code enabled me to identify the db and table that required attention. I really appreciate the help.

Thanks again.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top