Opening 2 recordsets in Access via ODBC SQL Linked Table

Question

I am working on converting our multiple access (2016) files / databases into one consolidated access file with navigation, and the data hosted on a SQL server (2014). Currently, we have a button that has the below code, and every time I get to an s.update line, I get the error "new transaction is not allowed because there are other threads running in the session".

I've been Googling for a day or 2 now and can't seem to get rid of it. I read that enabling MARS could help since I have 2 recordsets open, but that did not help. I do see the "MARS_Connection=Yes" on that tables connection string. I've also read that for loops can cause issues but none of the s.update lines are actually in a for loop. I've had trouble finding this issue in relation to Access

I'm relearning VBA as I go, I did not write this app and am open for suggestions.

Private Sub cmdNewWeek_Click()
    On Error GoTo ErrorHandler
    Dim r As DAO.Recordset, s As DAO.Recordset, f As Field, DifferentDate As Boolean, d As Date
    d = Date - (Weekday(Date) - 2)

    If IsNull(Me.cboSelAtty) Then
        MsgBox "Select an attorney first."
        cboSelAtty.SetFocus
    Else
        If IsNull(Me.employee) Then Me.employee = Me.cboSelAtty
        DoCmd.RunCommand acCmdSaveRecord
        DifferentDate = False
        MsgBox cboSelAtty
        Set r = CurrentDb.OpenRecordset("Select top 1 * From kt_workload Where employee=" & CSql(cboSelAtty) & " Order By week Desc", dbOpenSnapshot)
        Set s = CurrentDb.OpenRecordset("kt_workload", dbOpenDynaset, dbSeeChanges)
        If r.EOF Then
            s.AddNew
            s("employee") = cboSelAtty
            s("week") = d
            s.Update
            s.Close
            r.Close
            Me.Requery
            Exit Sub
        ElseIf r("week") >= d Then
            If MsgBox("A record for this week already exists. Do you want to enter one for a different week?", vbCritical + vbYesNo) = vbNo Then
                r.Close
                Exit Sub
            Else
                DifferentDate = True
            End If
        End If
        s.AddNew
        For Each f In r.Fields
            If f.Name <> "week" Then s(f.Name) = r(f.Name)
        Next
        s("week") = IIf(DifferentDate, r("week") + 7, d)
        s.Update
        s.Close
        r.Close
        Me.Requery
    End If
ErrorHandler:
    'Start ODBC error Catch
    Dim i As Integer
    Dim st As String
    For i = 0 To Errors.Count - 1
        st = st & Errors(i).Description & vbCrLf
    Next i
    MsgBox st, vbCritical
    'End ODBC error Catch
End Sub

Example Data (I couldn't get the table to format properly for whatever reason): Example Data

In the end, all we are doing is copying the most recent record as the 'test' fields are often similar week to week.

Edit: I trimmed down the function to the below. I do get 1 record back from my "r" record as expected. It gets applied to the "s" new record just fine.

but s.update throws the same error. Also, if I run this and run a SQL query through SSMS, that query hangs up until the access form throws the error (~60 seconds), so I'm not sure where I am going wrong with the SQL connection side I assume.

Trimmed Down Code:

Private Sub cmdNewWeek_Click()
    On Error GoTo ErrorHandler
    Dim r As DAO.Recordset, s As DAO.Recordset, DifferentDate As Boolean, d As Date
    d = Date - (Weekday(Date) - 2)
    Set r = CurrentDb.OpenRecordset("Select top 1 * From kt_workload Where employee=" & CSql("jcraig") & " Order By week Desc", dbOpenSnapshot)
    Set s = CurrentDb.OpenRecordset("kt_workload", dbOpenDynaset, dbSeeChanges)
    s.AddNew
    For Each f In r.Fields
        If f.Name <> "week" Then s(f.Name) = r(f.Name)
        Debug.Print s(f.Name)
    Next
    s("week") = d
    s.Update
    s.Close
    r.Close
        
ErrorHandler:
    'Start ODBC error Catch
    Dim i As Integer
    Dim st As String
    For i = 0 To Errors.Count - 1
        st = st & Errors(i).Description & vbCrLf
    Next i
    MsgBox st, vbCritical
    'End ODBC error Catch
End Sub

Answer 1

In the end, I think this is some connection issue unique probably to access 2016, SQL Server 2014 and ODBC 17 drivers. Instead of doing the double recordsource, I'm opening up the read recordsource and just using the values to insert a new record, and then I'll just select this new record. It works now at least.

  sql = "INSERT INTO kt_workload (employee, week, availweek, availMonth, availQtr, activeWeek, activeMonth, activeQtr) VALUES (" & _
          CSql(r("employee")) & ",'" & _
          r("week") & "'," & _
          CSql(r("availweek")) & "," & _
          CSql(r("availMonth")) & "," & _
          CSql(r("availQtr")) & "," & _
          CSql(r("activeWeek")) & "," & _
          CSql(r("activeMonth")) & "," & _
          CSql(r("activeQtr")) & _
          ");"
Debug.Print sql
CurrentDb.Execute sql

Answer 2

Whenever you need a recordset to only read data from, you should open it as snapshot.

In your case you only want to read the first record, so you should also use TOP 1.

Should you ever have an attorney named O'Brien, your code will break. Use Gustav's CSql() function when concatenating variables with SQL. It handles all strings and prevents SQL injection.

In summary:

strSql = "Select TOP 1 * From table1 Where employee=" & CSql(cboSelAtty) & " Order By week Desc"
Set r = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot)

This way you won't have conflicting transactions.

Note that your ODBC error handling loop should go into an On Error Goto xxx handler.