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)
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)