MS Access VBA & SQL Server - ODBC Call Failed on .Update of Recordset
I have an MS Access application that I'm converting to SQL Server Backend (still Access FE), with SQL Server Management Studio (SSMS).
The application stores HR information and there is a function that is supposed to build probation schedule due dates based on employment date and probation period.
Here's the function:
Private Sub BtnBuildSked_Click()
Const SUB_NAME As String = "BtnBuildSked_Click"
On Error GoTo ErrCond
Dim ThisReport, myresponse, MyStyle As Integer
Dim MYDB As Database
Dim Myrst, PdRec As DAO.Recordset
'Dim Myfrm As Form
Dim PdStr As String
Dim s, strsql As String
Dim t As TTracking
If Me.PaysrID.Value = "ON LEAVE" Then
MsgBox ("Record is marked ON LEAVE. Cannot proceed.")
Exit Sub
End If
'Set Myfrm = Screen.ActiveForm
Set MYDB = CurrentDb
s = "SELECT * FROM tblProbationReports"
Set Myrst = MYDB.OpenRecordset(s, dbOpenDynaset, dbSeeChanges)
MyStyle = vbOKOnly + vbExclamation
If IsNull(Me.PaysrID) Then
MsgBox ("Cannot process for empty Employee ID")
Exit Sub
End If
If (IsNull(Me.ApptDate)) Then
myresponse = MsgBox("Appointment Date field is empty ", vbCritical)
Exit Sub
End If
'----- Check that Probation Term ID is not blank
If (Me.ProbationTermId.Value < 1 Or Me.ProbationTermId.Value > 7 Or IsNull(Me.ProbationTermId)) Then
myresponse = MsgBox("You must select a probationary period to be able to build a schedule", MyStyle)
Exit Sub
End If
'----- Warning that any existing records for this employee will be deleted
myresponse = MsgBox("Warning!! This will delete any current probation schedule records for this Employee and Line No. combination. Do you want to proceed ?", vbYesNo)
Debug.Print myresponse
If myresponse = 7 Then
Exit Sub
End If
'------ Delete previous Probationary records for employee ; Keys = SS# and Line#
strsql = "DELETE tblProbationReports.* " & _
"FROM tblProbationReports " & _
"WHERE tblProbationReports.LineNo= '" & Me.LineNo & "' and tblProbationReports.PaysrID = '" & Me.PaysrID & "' "
DoCmd.SetWarnings False
DoCmd.RunSQL (strsql)
DoCmd.SetWarnings True
'----- Point to the approp recoird in Probation Data
PdStr = "SELECT * " & _
"FROM [tblProbationData] " & _
"WHERE [ProbationTermID] = " & Me.ProbationTermId.Value
'Set PdRec = MYDB.OpenRecordset("SELECT * FROM [tblProbationData] WHERE [ProbationTermID] = & me.ProbationTermID.Value & ")
Set PdRec = MYDB.OpenRecordset(PdStr)
If Not PdRec.EOF Then
For ThisReport = 1 To PdRec("ProbationReports")
'With Myrst
Myrst.AddNew
Myrst.Fields("LineNumber") = Me.LineNo
Myrst.Fields("SSNO") = Me.SSNo
Myrst.Fields("PaysrID") = Me.PaysrID
Myrst.Fields("ReportNo") = ThisReport
Select Case ThisReport
Case 1
Myrst.Fields("FromDate") = Me.ApptDate
Myrst.Fields("ToDate") = Me.ApptDate + (PdRec("Report1weeks") * 7) '-1
Myrst.Fields("DueDate") = Me.ApptDate + (PdRec("Report1weeks") * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + (PdRec("Report1weeks") * 7) - 1 - 28
Case 2
Myrst.Fields("FromDate") = Me.ApptDate + (PdRec("Report1weeks") * 7)
Myrst.Fields("ToDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks")) * 7) '- 1
Myrst.Fields("DueDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks")) * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks")) * 7) - 1 - 28
Case 3
Myrst.Fields("FromDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks")) * 7)
Myrst.Fields("ToDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks")) * 7) '- 1
Myrst.Fields("DueDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks")) * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks")) * 7) - 1 - 28
Case 4
Myrst.Fields("FromDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks")) * 7)
Myrst.Fields("ToDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks")) * 7) '- 1
Myrst.Fields("DueDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks")) * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks")) * 7) - 1 - 28
Case 5
Myrst.Fields("FromDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks")) * 7)
Myrst.Fields("ToDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7) '- 1
Myrst.Fields("DueDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7) - 1 - 28
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7) - 1 - 42
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7) - 1 - 56
Case 6
Myrst.Fields("FromDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7)
Myrst.Fields("ToDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) '- 1
Myrst.Fields("DueDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 28
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 42
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 56
Case 7
Myrst.Fields("FromDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks")) * 7)
Myrst.Fields("ToDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) '- 1
Myrst.Fields("DueDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 14
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 28
Myrst.Fields("SentDate") = Me.ApptDate + ((PdRec("Report1weeks") + PdRec("Report2weeks") + PdRec("Report3weeks") + PdRec("Report4weeks") + PdRec("Report5weeks") + PdRec("Report6weeks")) * 7) - 1 - 56
End Select
Myrst.Fields("Received") = False
Myrst.Update
'End With
Next ThisReport
End If
'set up tracking manually
t.Comment = "Build New Schedule"
t.FieldName = "LineNo"
t.ItemID = Me.LineNo
t.NewValue = "New Schedule Built"
t.OldValue = ""
t.TableName = "tblProbationReports"
t.TrackingType = TR_TYPE_NEW
SaveTrans t
Myrst.Close
PdRec.Close
'Myfrm.SetFocus
Me.Recalc
MsgBox ("Probation dates created")
Exit Sub
ErrCond:
EventLogging AppSession.UserName, MSG_TYPE_ERROR, Err.Number, Err.Description, MOD_NAME & "." & SUB_NAME, AppSession.AppSilent
End Sub
The first several blocks are checks for properly formatted employeeID, and active status.
Code warns that any new schedule will delete previous values.
Then the application is supposed to build the new schedule based on probation period (the various Case statements) and employment date.
But when the code drops to .Update, it fails with "ODBC Call Failed".
Here's a rundown of notes and troubleshooting thus far:
Nothing wrong with the connection to the BE. I'm able to create, update, and delete employee records without issue. I can see data in the tables when opening via Access FE. I can run reports.
"Probation Reports" table did not have a primary key, which I needed to add in order to create Audit triggers in SSMS (I know table should have primary key, but I wasn't the original developer).
I made "RecordID" Primary Key in "Probation Reports" table and made it "Identity" in order to increment the unique identifier automatically.
When making RecordID "Identity" to increment sequentially in SSMS, Access errored out on Recordset.Open of "Probation Reports" ... "table with identity needs dbSeeChanges on open of Recordset"
Trying Recordset.Open ("name", ,dbSeeChanges) still errored out, "table with identity needs dbSeeChanges on open of Recordset". Access was not reading "dbSeeChanges" Option value
I needed to add an open "Type" (although optional) in order for Access to read the open "Options" value of "dbSeeChanges".
I've tried every value for Open "Type" learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/database-openrecordset-method-dao (even ones that didn't make sense). This is where the .Update breaks with "ODBC Connection Failed"
I tried adding LockEdit value option of "dbOpenOptimistic" and still getting the "ODBC Call Failed" error ...
I'm at a loss of where to go from here...
UPDATE - based on feedback in comments, I tried adding values to the table directly and received the following error (screenshot)
The culprit is/was actually one of the fields in this db (and subsequent code above): "LineNo"
"LineNo" is a RESERVED WORD in SQL Server.
After implementing all sorts of suggestions, this one crept up from ....I don't even remember where but here's an article of reserved words in SQL Server for future reference for others:
Changing ALL references to this field from "LineNo" to "LineNum" resolved all errors.
- Getting unique values from a column
- How to filter Not Red Cells?
- Split sheets based on conditions in Excel
- Unable to extract complete page source using selenium
- How can I use the wildcard function in a Word VBA macro with an array?
- Import string to formula - VBA
- Can I nest a With inside a With when both are designating a different sheet in the same workbook? VBA
- Creating a formula in vba using cell values
- Wait until Application.Calculate has finished
- How to apply custom text format with Excel Scripts
- Replace characters in text file faster
- SQL string throws "External Name not Defined" error when running in VBA module - Name is defined
- Cut columns whenever threshold is reached
- How do i count items in a multi item drop down cell
- Send mail based on sheet name
- VBA equivalent to Excel's mod function
- Integer Vs Long Confusion
- Export all appointments and meetings, including recurring meetings
- Word VBA macro with multiple find/replace options for single-word selection only works if the selection contains the first F/R option
- Insert Multiple Rows and Values in Excel in various Places with VBA
- VBA Characters.Delete string over 255 characters
- Overflow when calculating a const in VBA
- problem with VBA code for vlookup from a few different workbooks
- Error when assigning a macro to a button on excel with
- Getting the actual usedrange
- Extract non-contiguous data from multiple sheets while extracting from a list with a loop
- Excel VBA - Skip renaming when cell empty
- Protected Cell warning when returning to original cell after DoubleClick
- Pass an array to a function from a multidimensional array
- Partial value font color in red using vba