Runtime 3186 Lock by Admin on Machine

[craigachan]

I'm at my wits end. I have an unbound input form with many text/memo fields that i'm updating to the record. When my code gets to a particular memo field it spits out error 3186 - Can't save record is locked by 'Admin' on machine 'myworkstation'. The interesting thing is that I'm very sure that my workstation is not logged on as 'Admin' and and I'm working on the machine that it states is locking the record. Basically, its stating that I can save this record because I'm on the record using it.

Also interesting, it lets me update other text fields or memo fields but not just this memo field in the record. I've narrowed it down to when the field size is greater than about 2400 charactors it starts to give me '3186'. Smaller than that it runs and saves all fields as planned.

Prior to this error, I was saving the record by opening an input form "ChartNotes", saving and then closing the form which worked very well for several years. I then recoded it to open a DAO recordset to do the save and that is when my problem started. I also tried saving the record by running it with docmd.runsql and not opening a recordset per se, but got the same error. I've gone thru my code and made sure all open forms were closed, and closed all recordset when opened and set them to nothing.

My question. If the record is open in another instance, for some reason on my workstation and I dont' think it is, why does it let me save the other fields on the record and then locks this memo field. If I skip this memo field it saves as planned. What does the field size of the memo field have to do with anything? I thought it might be some escapes but eliminated these with code.

I read somewhere it might be damaged files and did an Access Repair but this did not help.

My workaround it to save the memo field that I'm trying to save to a txt file when the error occurs. then open the record in an editing form and then pasting the field contents into the field. But this is annoying to do when I'm busy.

Would appreciate any input.

 

[JHB]

After the "Compact & Repair" which you already have done, I would create a new database and import all into it.
Next I would do, would be to create a new memo field in the table and fill it with the data from the memo field with the problem, (use a update query), and then delete the problem memo field. Use a copy of the database.
When you say the other memo fields gets saved without problem, how much data do you have in the field?

 

[craigachan]

Thanks for your reply JHB.

The problem memo field is where we keep our clinical notes that are ongoing. This is the largest of the memo fields. Most of the other memo fields well probably stay under 255 but I have made it a memo field because of the possibility of exceeding the 255.

I like your suggestions JHB and will give it a try. Its funny how one can get in such a rut for things like these and forget to stand back and take in the whole picture. You have help me stand back and get a better point of view.

 

[craigachan]

Okay, Here is what I did:
1) exported the affected memo field 'nNotes' to a new blank AccessDB
2) In the new DB, I added to the table a new memo field 'nNotes1'
3) Copied all of the contents of nNotes to nNotes1 in each record.
4) removed in nNotes from the table
5) renamed nNotes1 to nNotes
6) Compact/Repair. new db
7) Relinked original DB to that table in the new DB
8) Compact/Repair original DB

Result: No Change, still errors 3186.

Can you comment as to whether this was what you were suggesting I do? Any other ideas? Thank you.

 

[JHB]

..
Can you comment as to whether this was what you were suggesting I do?

It is exactly what it suggested!

Any other ideas? Thank you.

You write it started when you started to use a DAO recordset, can't you change the code back to what it was before?
Why not use an append or update query?
Did you try to run the program on another computer?
Could you post a stripped version of you database with some sample data, (and how to reproduce the error)?

 

[craigachan]

So here is what I've done:

I went back and re did the code to save it thru a form both to just save one field (the problem field called 'OpNote') and to save the whole record. But this results in the same problem. The funny thing here is even though I have error handling to catch error 3186 turned off so to speak in my code, It doesn't even error out and ignores saving this field. No error happens and the code finishes. Here is the code for saving the record thru the form:

Public Sub FormInputSaveSomeFields()
On Error GoTo SavesomeFieldsErr
'========1/10/2011 =  This code specific for Forms!ChartNoteGenSx

'===SaveFieldCode is set up from Forms!ChartNoteGenSxWho, under DisableFields Sub
'====Setup SaveFieldsCode
'=====This field is not really a code field on CHANNotes.  It acts as a code to determine
'=====which fields are to be save as determined by ChartNoteGenSxWho.  This protects staff
'     from overwritting doctor changes and visa versa.

'0-NPO, 1-Ride, 2-PreVits, 3-MedCode, 4-ProcCode, 5-ProcCodeA, 6-TypeCode, 7-TypeCodeA
'8-Implants, 9-opUR, 10-opUL, 11-opLR, 12-opLL, 13-StFinCode, 14-VitalsCode, 15-SutPak
'16-POInstCode, 17-MedInt, 18-GasInt, 19-IVMon, 20-Staff, 21-AsstSx, 22-AsstPO
'23-OpNote, 24-PONote, 25-Rx


Dim SavRay() As String
'Dim y As Long


Dim frmCN As Form
Dim frmCSx As Form
Set frmCSx = Forms!ChartNoteGenSx

    DoCmd.OpenForm "ChartNote", , , "nid =" & Forms!ChartNoteGenSx.nID, , acHidden
    Set frmCN = Forms!ChartNote

    If IsNull(frmCSx!SaveFieldsCode) Then
        frmCSx!SaveFieldsCode = "x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x"
        GoTo SavesomeFieldsExit
    End If
    
'0-NPO, 1-Ride, 2-PreVits, 3-MedCode, 4-ProcCode, 5-ProcCodeA, 6-TypeCode, 7-TypeCodeA
'8-Implants, 9-opUR, 10-opUL, 11-opLR, 12-opLL, 13-StFinCode, 14-VitalsCode, 15-SutPak
'16-POInstCode, 17-MedInt, 18-GasInt, 19-IVMon, 20-Staff, 21-AsstSx, 22-AsstPO
'23-OpNote, 24-PONote, 25-Rx
        
        '=====For testing Delete after test
        '"1-1-1-1-1-1-1-1-1-1-1-1-1-1-1-1-2-x-x-x-x-x-x-x-x-x"
           ' frmCSx.SaveFieldsCode = "x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x"
            
    SavRay() = Split(frmCSx!SaveFieldsCode, "-")

    If SavRay(0) <> "x" Then                                'anything other than 'x'=Save field otherwise ignore changes
            If DLookup("NPOStatus", "CHANNotesTblNPOStatus") <> frmCSx!NPOStatus Then
                frmCN!NPOStatus = frmCSx!NPOStatus                  '==Only Save if date is current
            End If
    End If

    If SavRay(1) <> "x" Then
            frmCN!Ride = frmCSx!Ride
    End If
        
    If SavRay(2) <> "x" Then
            frmCN!PreVitCode = frmCSx!PreVitCode
    End If
        
    If SavRay(3) <> "x" Then
            frmCN!MedCode = frmCSx!MedCode
    End If
        
    If SavRay(4) <> "x" Then
            frmCN!ProcCode = frmCSx!ProcCode
    End If
    If SavRay(5) <> "x" Then
        frmCN!ProcCodeA = frmCSx!ProcCodeA
    End If
    If SavRay(6) <> "x" Then
        frmCN!TypeCode = frmCSx!TypeCode
    End If
    
    If SavRay(7) <> "x" Then
        frmCN!TypeCodeA = frmCSx!TypeCodeA
    End If
    
    If SavRay(8) <> "x" Then
        frmCN!Implants = frmCSx!Implants
    End If
    
    If SavRay(9) <> "x" Then
        frmCN!opUR = frmCSx!opUR
    End If
    
    If SavRay(10) <> "x" Then
        frmCN!opUL = frmCSx!opUL
    End If
        
    If SavRay(11) <> "x" Then
        frmCN!opLR = frmCSx!opLR
    End If
        
    If SavRay(12) <> "x" Then
        frmCN!opLL = frmCSx!opLL
    End If
    If SavRay(13) <> "x" Then
        frmCN!StartFinCode = frmCSx!StartFinCode
        
    End If
    
    If SavRay(14) <> "x" Then
        frmCN!VitalsCode = frmCSx!VitalsCode
    End If
    
    If SavRay(15) <> "x" Then
        frmCN!SutPakCode = frmCSx!SutPakCode
    End If
    
    If SavRay(16) <> "x" Then
        frmCN!POInstCode = frmCSx!POInstCode
    End If
    
    If SavRay(17) <> "x" Then
        frmCN!MedIntervals = frmCSx!MedIntervals
    End If
    
    If SavRay(18) <> "x" Then
        frmCN!GasIntervals = frmCSx!GasIntervals
    End If
    
    If SavRay(19) <> "x" Then
        frmCN!IVMonCode = frmCSx!IVMonCode
    End If
    If SavRay(20) <> "x" Then
        frmCN!Staff = frmCSx!Staff
    End If
        
    If SavRay(21) <> "x" Then
        frmCN!AsstSx = frmCSx!AsstSx
    End If
    If SavRay(22) <> "x" Then
        frmCN!AsstPO = frmCSx!AsstPO
    End If

        '=====================================OPNOTE=====================
    'MsgBox Mid(frmCSx!OpNote, 2000)
    If SavRay(23) <> "x" Then
       frmCN!nNote = frmCSx!OpNote
    End If
        '=================================================================

    If SavRay(24) <> "x" Then
        frmCN!TxSumNote = FixEscapesInSql(frmCSx!TxSumNote)
    End If
    
    If SavRay(25) <> "x" Then
        frmCN!Rx = FixEscapesInSql(frmCSx!Rx)
    End If
    
    If Not IsNull(frmCSx.DOS) Then
        frmCN!DOS = frmCSx!DOS
    End If
    
    If Not IsNull(frmCSx!nConsID) Then
        frmCN!nConsID = frmCSx.nConsID
    End If
        
    frmCSx!togChg = ""

SavesomeFieldsExit:
    'DoCmd.Close acForm, "ChartNote"
    DoCmd.SetWarnings True
    Exit Sub
SavesomeFieldsErr:
    'If Err.Number = "3186" Then
    '    MsgBox "The field size might have been exceeded. Start a new note." & vbCrLf & vbCrLf & "The note has been save in the patient's file as Backup.txt"
    '    Dim strPathFileName As String
    '    strPathFileName = DLookup("PDocs", "CHANLinkPaths") & "\" & Forms!ChartMain!nPID & "\DocNoteBackup.txt"
    '    Call WriteToTxtFile(frmCSx!OpNote, strPathFileName)
    'Else
        MsgBox "ChartPublic-SavesomeFields: " & Err.Number & " - " & Err.Description
        
    'End If
    Resume SavesomeFieldsExit
End Sub

Here is the code using DAO recordset. And you can also see that I also have a versions that is memo'd out using docmd.runsql versions.

Public Sub SaveSomeFields()
On Error GoTo SavesomeFieldsErr
'========1/10/2011 =  This code specific for Forms!ChartNoteGenSx

'===SaveFieldCode is set up from Forms!ChartNoteGenSxWho, under DisableFields Sub
'====Setup SaveFieldsCode
'=====This field is not really a code field on CHANNotes.  It acts as a code to determine
'=====which fields are to be save as determined by ChartNoteGenSxWho.  This protects staff
'     from overwritting doctor changes and visa versa.

'0-NPO, 1-Ride, 2-PreVits, 3-MedCode, 4-ProcCode, 5-ProcCodeA, 6-TypeCode, 7-TypeCodeA
'8-Implants, 9-opUR, 10-opUL, 11-opLR, 12-opLL, 13-StFinCode, 14-VitalsCode, 15-SutPak
'16-POInstCode, 17-MedInt, 18-GasInt, 19-IVMon, 20-Staff, 21-AsstSx, 22-AsstPO
'23-OpNote, 24-PONote, 25-Rx

Dim RS As DAO.Recordset
Dim SavRay() As String
Dim y As Long
Dim strsavefields, Spacer, strTemp As Variant
'Dim strfieldname As Variant
'Dim CNSql As String
Set RS = CurrentDb.OpenRecordset("SELECT * FROM CHANNotes WHERE nID = " & Forms!ChartNoteGenSx!nID, dbOpenDynaset)

strsavefields = Null
'DBEngine.Idle (dbFreeLocks)
'Dim frmCN As Form
Dim frmCSx As Form
Set frmCSx = Forms!ChartNoteGenSx
        '---Check to see if ChartNote is open, if not open it
   ' If IsLoaded("ChartNote") <> True Then
   '     DoCmd.OpenForm "ChartNote", , , "nid =" & Forms!ChartNoteGenSx.nID, , acHidden
   '     Set frmCN = Forms!ChartNote
   ' End If

    If IsNull(frmCSx!SaveFieldsCode) Then
        frmCSx!SaveFieldsCode = "x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x"
        GoTo SavesomeFieldsExit
    
    End If
    
'0-NPO, 1-Ride, 2-PreVits, 3-MedCode, 4-ProcCode, 5-ProcCodeA, 6-TypeCode, 7-TypeCodeA
'8-Implants, 9-opUR, 10-opUL, 11-opLR, 12-opLL, 13-StFinCode, 14-VitalsCode, 15-SutPak
'16-POInstCode, 17-MedInt, 18-GasInt, 19-IVMon, 20-Staff, 21-AsstSx, 22-AsstPO
'23-OpNote, 24-PONote, 25-Rx
        
        '=====For testing Delete after test
        '"1-1-1-1-1-1-1-1-1-1-1-1-1-1-1-1-2-x-x-x-x-x-x-x-x-x"
           ' frmCSx.SaveFieldsCode = "x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x"
            
    SavRay() = Split(frmCSx!SaveFieldsCode, "-")
With RS
    .Edit

        If SavRay(0) <> "x" Then                                'anything other than 'x'=Save field otherwise ignore changes
            If DLookup("NPOStatus", "CHANNotesTblNPOStatus") <> frmCSx!NPOStatus Then
                'frmCN!NPOStatus = frmCSx!NPOStatus                  '==Only Save if date is current
                !NPO = frmCSx!NPOStatus
                
                'GoSub routineSpacer
                'strsavefields = strsavefields & Spacer & "NPO = '" & frmCSx!NPOStatus & "'"
            End If
        End If

        If SavRay(1) <> "x" Then
            'frmCN!Ride = frmCSx!Ride
            !Ride = frmCSx!Ride
            
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "Ride = '" & frmCSx!Ride & "'"
        End If
        If SavRay(2) <> "x" Then
            'frmCN!PreVitCode = frmCSx!PreVitCode
            !Previtecode = frmCSx!PreVitCode
            
            'GoSub routineSpacer
            'strTemp = FixEscapesInSql(frmCSx!PreVitCode)
            'MsgBox strTemp
            'strsavefields = strsavefields & Spacer & "PreVitCode = '" & strTemp & "' "
        End If
        If SavRay(3) <> "x" Then

            !MedCode = frmCSx!MedCode
            'GoSub routineSpacer
            
            'strsavefields = strsavefields & Spacer & "MedCode = '" & FixEscapesInSql(frmCSx!MedCode) & "'"
            'strsavefields = strsavefields & Spacer & "MedCode = '" & FixEscapesInSql(tstring) & "'"
        End If
        If SavRay(4) <> "x" Then
            'frmCN!ProcCode = frmCSx!ProcCode
            !ProcCode = frmCSx!ProcCode
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "ProcCode = '" & frmCSx!ProcCode & "' "
        End If
        If SavRay(5) <> "x" Then
            'frmCN!ProcCodeA = frmCSx!ProcCodeA
            !ProcCodeA = frmCSx!ProcCodeA
            
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "ProcCodeA = '" & frmCSx!ProcCodeA & "' "
        End If
        If SavRay(6) <> "x" Then
            !TypeCode = frmCSx!TypeCode
            
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "TypeCode = '" & frmCSx!TypeCode & "' "
        End If
        If SavRay(7) <> "x" Then
            !TypeCodeA = frmCSx!TypeCodeA
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "TypeCodeA = '" & frmCSx!TypeCodeA & "' "
        End If
        If SavRay(8) <> "x" Then
            !Implants = frmCSx!Implants
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "Implants = '" & frmCSx!Implants & "' "
        End If
        If SavRay(9) <> "x" Then
            If Not IsNull(frmCSx!opUR) Then !opUR = FixEscapesInSql(frmCSx!opUR)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!opUR) Then strsavefields = strsavefields & Spacer & "opUR = '" & FixEscapesInSql(frmCSx!opUR) & "' "
        End If
        If SavRay(10) <> "x" Then
            If Not IsNull(frmCSx!opUL) Then !opUL = FixEscapesInSql(frmCSx!opUL)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!opUL) Then strsavefields = strsavefields & Spacer & "opUL = '" & FixEscapesInSql(frmCSx!opUL) & "' "
        End If
        'MsgBox strsavefields
        'GoSub SaveCurrentString
        'strsavefields = Null
        'MsgBox "Saved 1-10"
        
        If SavRay(11) <> "x" Then
            If Not IsNull(frmCSx!opLR) Then !opLR = FixEscapesInSql(frmCSx!opLR)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!opLR) Then strsavefields = strsavefields & Spacer & "opLR = '" & FixEscapesInSql(frmCSx!opLR) & "' "
        End If
        If SavRay(12) <> "x" Then
            If Not IsNull(frmCSx!opLL) Then !opLL = FixEscapesInSql(frmCSx!opLL)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!opLL) Then strsavefields = strsavefields & Spacer & "opLL = '" & FixEscapesInSql(frmCSx!opLL) & "' "
        End If
        If SavRay(13) <> "x" Then
            !StartFinCode = frmCSx!StartFinCode
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "StartFinCode = '" & frmCSx!StartFinCode & "' "
        End If
        If SavRay(14) <> "x" Then
            !VitalsCode = frmCSx!VitalsCode
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "VitalsCode = '" & frmCSx!VitalsCode & "' "
        End If
        If SavRay(15) <> "x" Then
            !SutPakCode = frmCSx!SutPakCode
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "SutPakCode = '" & frmCSx!SutPakCode & "' "
        End If
        If SavRay(16) <> "x" Then
            If Not IsNull(frmCSx!POInstCode) Then !POInstCode = FixEscapesInSql(frmCSx!POInstCode)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!POInstCode) Then strsavefields = strsavefields & Spacer & "POInstCode = '" & FixEscapesInSql(frmCSx!POInstCode) & "' "
        End If
        If SavRay(17) <> "x" Then
            !MedIntervals = frmCSx!MedIntervals
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "MedIntervals = '" & frmCSx!MedIntervals & "' "
        End If
        If SavRay(18) <> "x" Then
            !GasIntervals = frmCSx!GasIntervals
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "GasIntervals = '" & frmCSx!GasIntervals & "' "
        End If
        If SavRay(19) <> "x" Then
            !IVMonCode = frmCSx!IVMonCode
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "IVMonCode = '" & frmCSx!IVMonCode & "' "
        End If
        If SavRay(20) <> "x" Then
            If Not IsNull(frmCSx!Staff) Then !Staff = FixEscapesInSql(frmCSx!Staff)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!Staff) Then strsavefields = strsavefields & Spacer & "Staff = '" & FixEscapesInSql(frmCSx!Staff) & "' "
        End If
        
        'GoSub SaveCurrentString
        'strsavefields = Null
        'MsgBox "Saved 11-20"
        
        If SavRay(21) <> "x" Then
            If Not IsNull(frmCSx!AsstSx) Then !AsstSx = FixEscapesInSql(frmCSx!AsstSx)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!AsstSx) Then strsavefields = strsavefields & Spacer & "ASxNotes = '" & FixEscapesInSql(frmCSx!AsstSx) & "' "
        End If
        If SavRay(22) <> "x" Then
            If Not IsNull(frmCSx!AsstPO) Then !AsstPO = FixEscapesInSql(frmCSx!AsstPO)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!AsstPO) Then strsavefields = strsavefields & Spacer & "AsstPO = '" & FixEscapesInSql(frmCSx!AsstPO) & "' "
        End If
        
        'GoSub SaveCurrentString
        'strsavefields = Null
        '=====================================OPNOTE=====================
        'saveray(23) or OpNote is saved later at bottom thru Form ChartNote
        If SavRay(23) <> "x" Then
            Dim temp As Variant
            temp = frmCSx!OpNote
            MsgBox temp
            If Not IsNull(frmCSx!OpNote) Then !nNote = temp
            '------ORIGINAL
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!OpNote) Then strsavefields = strsavefields & Spacer & "nNote = '" & FixEscapesInSql(frmCSx!OpNote) & "' "
            'MsgBox Len(frmCSx!OpNote)
            '------ORIGINAL
        End If
        
        'GoSub SaveCurrentString
        'strsavefields = Null
        '=================================================================

        If SavRay(24) <> "x" Then
            If Not IsNull(frmCSx!TxSumNote) Then !TxSumNote = FixEscapesInSql(frmCSx!TxSumNote)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!TxSumNote) Then strsavefields = strsavefields & Spacer & "TxSumNote = '" & FixEscapesInSql(frmCSx!TxSumNote) & "' "
        End If
        If SavRay(25) <> "x" Then
            If Not IsNull(frmCSx!Rx) Then !Rx = FixEscapesInSql(frmCSx!Rx)
            'GoSub routineSpacer
            'If Not IsNull(frmCSx!Rx) Then strsavefields = strsavefields & Spacer & "Rx = '" & FixEscapesInSql(frmCSx!Rx) & "' "
        End If
        
        If Not IsNull(frmCSx.DOS) Then
            !DOS = frmCSx!DOS
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "DOS = #" & frmCSx.DOS & "#"
        End If
        
        If Not IsNull(frmCSx!nConsID) Then
            !nConsID = frmCSx.nConsID
            'GoSub routineSpacer
            'strsavefields = strsavefields & Spacer & "nConsID = '" & frmCSx.nConsID & "' "
        End If
        
        'GoSub SaveCurrentString
        'strsavefields = Null
       
    .Update
    .Close
End With
        frmCSx!togChg = ""

SavesomeFieldsExit:
    DoCmd.Close acForm, "ChartNote"
    Set RS = Nothing
    DoCmd.SetWarnings True
    Exit Sub
SavesomeFieldsErr:
    'If Err.Number = "3186" Then
    '    MsgBox "The field size might have been exceeded. Start a new note." & vbCrLf & vbCrLf & "The note has been save in the patient's file as Backup.txt"
    '    Dim strPathFileName As String
    '    strPathFileName = DLookup("PDocs", "CHANLinkPaths") & "\" & Forms!ChartMain!nPID & "\DocNoteBackup.txt"
    '    Call WriteToTxtFile(frmCSx!OpNote, strPathFileName)
    'Else
        MsgBox "ChartPublic-SavesomeFields: " & Err.Number & " - " & Err.Description
        
    'End If
    Resume SavesomeFieldsExit
routineSpacer:
    If IsNull(strsavefields) Then
        Spacer = Null
    Else
        Spacer = ", " & vbCrLf
    End If
    Return

SaveCurrentString:
        'MsgBox "Fields to save: " & vbCrLf & strsavefields
        If strsavefields <> "" Then
         
        
        '======OLD
            'CNSql = "UPDATE CHANNotes SET " & strsavefields & _
                        "WHERE nID = " & Forms!ChartNoteGenSx.nID
            'DoCmd.SetWarnings False
            'MsgBox CNSql
            'DoCmd.RunSQL CNSql
        End If
        Return
End Sub

Both ways now produce some error when the memo field being saved gets greater than approx 2300 char. With the form - it doesn't save and doesn't give notice. With the DAO.recordset, I get the 3186. When the OpNote Field is less than that, it saves the record fine. Once the field gets this large, I get err.3186 and even if I try to shorten the field size down, it continues to error out. It's like the record gets corrupted.

Another interesting factoid. Because of this problem, I started to copy the !OpNote memo field to a backup table before saving the record. It successfully saves the whole !OpNote memo field to the backup table but will even ignore saving it to the record where it is supposed to be.

One More factoid. Occasionally, but not always, I've noticed when stepping thru the code using the debugger, the !OpNote will save sometimes but not consistently. When I tried to slow the processing down with DoEvents, or actually pausing the code with a timer, and even DBEngine.Idle (dbFreeLocks) (I don't know exactly how these affect things) I would still get the errors as mentioned above.

I've repaired my developers version of Access 2010 and then also updated to Access2013. But I still have the problems. I've read online some hints that some dlls may have gotten corrupted but I don't know where to start to look for these. I get the problem on both the developers and runtime versions.

Any ideas? Thanks for your help.

 

[JHB]

What if you try to save it on of the other memo field you write you've?
Could you post a stripped version of your database with some sample data?

 

[jdraw]

I agree with JHB -- readers need something to work with (database with sample data--remove anything private).

 

[JHB]

I've made a small sample database with a memo field in, try if you've have any problem saving a record using the recordset method, click the button on the form.
Could you problem be, you are locking the record by the open form, the same record which you want to update using the code?

 

[craigachan]

Here is the best I can strip my FE and BE down. Hopefully it helps. I've exported to a new accdb call AccessEMRSample.

Hang on, I'm cant quite figure out how to attach. It says I cant upload because I'm missing a security token? I'll work on stripping my DB down in case its too big. Any help with attaching would be appreciate so I can upload.

 

[craigachan]

I couldn't upload the dbs as an attachement but here you can download it from sftp.chanomfs.com. I'll keep the files up for only this weekend (3/21-23/2015) and then have to remove the files. In case I stripped out too many of the tables you can re-import them from the BE db AccessEMRDB.accdb

Open AccessEMRSample.accdb


To produce the error:
1) Select the only fictional patiient is this db, upper right cbo selectpt. 'Aardema, Rosa'
2) click on the first record in the subform 'ChartMainSub' - Date 3/18/2015 - this opens ChartNoteGenSx- let the info load. It will be loaded in a read-only state.
3) Half way down this form 'ChartNoteGenSx' there is a button cmdDoc1 - it has a lock image for the button image. You may also click on the 'Doctor' button up to the right on the form that does the same thing. This makes the doctor's field editable and will change the background colors.
4) Click on the !OpNote field and this will open Form!Zoomsxopnote. This is the form where you may add to the Doctor Notes field. In this record the field is already large enough to produce the error. Just close it which takes you back to ChartNoteGenSx. Close this form to save the form - code in the module ChartPublic will run Public sub SaveSomeFields. Look at SavRay(23) which is the part of the code that produces the error. If I highlight this field out, the code runs fine but off course does not save the OpNote field.

Keep in mind, prior to Forms!ChartNoteGenSx!opNote getting to be around 2300 characters, the code works fine. You can test this if you click on the in ChartMain!ChartMainSub to the records dated 3/21/2015.

Record dated 2/18/2015 is the one the produces error 3186.

Thank you for your help.

 

[JHB]

.

Record dated 2/18/2015 is the one the produces error 3186.

I think it is a typo - you mean 03/18/2015 don't you?
I've downloaded your database, open it like you describe add the double text according to MS-Word >4700 characters in it BUT I do not get any error and it saves okay!
Only problem is when I click the button "Close All" then an error appear in the line "If frmCN.Dirty Then" in the sub "CloseAllForms()", but it has nothing to do with record locked.

Did you try my database?
When I'm not able to reproduce the error, I don't know how to help you.
What if you download your own database, do you still get the lock error?

 

[craigachan]

Thanks for replying JHB. You're right the date with the error is 3/18/2015.

My FE is so big it would be too big to upload and would take for ever. I exported by actual FE to a new blank DB call AccessEMRSample.accdb. So I believe it should be a clean one. But I only exported the objects that were required for me to demostrate the error. There are a lot of tables that are either empty or deleted from the SampleDB that I had to empty to protect patient info or delete to get the SampleDb smaller to upload. When I run the AccessEMRSample.accdb, I get the same error as my original DB. I thought my MSAccess2013 developer's version at work was corrupted but when I open the sample db at home, also a developers version, it also produces the same error. So I'm assuming its the Sample db itself and not the actual MSAccess.

Regarding the CloseAllForms, This uses a similar pathway but not the exact same pathway that just closes the single form. I would not use this button for now as I didn't have time to run thru all of the code to make sure I included all of the objects to make it work. So use the single form close for now. Unless you feel that the error lay with that code. In the full full versions of my db it produces the same error 3186 both ways. Ultimately both ways of closing the form pass thru 'SaveSomeFields Function' where the code seems to hang up.

I'm working at home today. I deleted AccessEMRSample.accdb from my computer and then redownloaded the db from my sftp site and still get the error. (to answer your previous question.)

Try this to get the error. You might have to go into design mode in Forms!ChartNoteGenSx to find the right buttons:

1) After opening the ChartNoteGenSx, unlock the doctor's fields by clicking .cmdDoc1 button
2) After the doctor field's background change to white, then click .cmdClose1 button. The error should occur.

If you do the same with ChartNote dated 3/21/2015, it doesn't happen, at least for me.

I did try your DB and did not get the error to occur. But I'll try your db again here at home and let you know.

I believe the actual table 'ChanNotes' might be corrupted. My basis is that I can actually add for text to the field and save it in my ChanNoteBackup table without problem. You can see this happen since I back up the !opNote field before it runs the SaveSomeFields code.

What do you think? Thanks again for helping me.

 

[craigachan]

JHB,

I tried your attached .mdb and did not get any errors. This is how my DB worked at one time for actually several years. I was able to add text to the field in question of very significant sizes without problem. I've actually gone back to some records created several years ago but now get the error when I close the form. But it must have worked before since those records have way more than 2300 characters when they were originally saved

As mentioned above, I tried your solution of copying all of the ChanNotes!nNote field to a inserted nNote1 in the same table. Then deleted the original nNote field, then renamed the nNote1 to nNote. But this did not fix the issue. I tried exporting the table to a blank db then copy/paste the record into to the newly created table, but this did not work. My thinking now is that I might be replicating corruption in the structure of the table. I think I'm going to try to make a new table from scratch and then use a query to copy the field contents from the original table to the new. I'm hoping that by doing this I'm not transferring any corruption of the table structure to the new table. Will try it out next.

 

[JHB]

After clicking the cmdDoc1 button many times after each other I occasionally get the error you've, but it is very random when it occurs. It can be after 20-30 clicks or more.
I've comment out your errorhandling in 2 places, on in the "Sub SaveSomeFields()" and I think the other was in the "Sub cmdDoc_Click()" then I want the running code to stop in the codeline in which the error occur.
What I recognized was, when the code stops and a wait a little, I could continue without any error - what I think happen is, that it is locked because the program haven't had time enough to finish the previous writings.

It may well fit in with what you describe, in the beginning there was not as much data in your table and therefore the program could well follow, but now that there are many data error occurs more frequently.

Try to comment out the errorhandling in the 2 places and see if the code continue after a little by you - like by me.
I have a fairly new computer with Windows 8, and not many other programs running in the background, therefore I believe that I am experiencing the error very rarely.

 

[craigachan]

Perhaps it is a matter of slowing down the code in the right place. As I said before, If I step thru the code, it will sometime save without error. But I can't seem to find the spot to slow it down. I've tried DoEvents, DBEngine Idle, a function called pauseApp but I can't seem to find the spot that I need to put it in. Were you able to find the line in the code where this happens?

 

[JHB]

You can try to add/change the below code in "SaveSomeFields()", remember to make the errorhandling active again if you've comment it out.
I can't test the code, because I've no error today.

...
Dim y As Long[B][COLOR=Red], Errcounter As Integer[/COLOR][/B]
Dim strsavefields, Spacer, strTemp As Variant
DoCmd.SetWarnings True
[B][COLOR=Red]Errcounter = 0[/COLOR][/B]
..
.
SavesomeFieldsErr:
    
    If Err.Number = "3186" Then
      DoEvents
      Errcounter = Errcounter + 1
      MsgBox "ErrCunter " & Errcounter
      Resume
    '    MsgBox "The field size might have been exceeded. Start a new note." & vbCrLf & vbCrLf & "The note has been save in the patient's file as Backup.txt"
    '    Dim strPathFileName As String
    '    strPathFileName = DLookup("PDocs", "CHANLinkPaths") & "\" & Forms!ChartMain!nPID & "\DocNoteBackup.txt"
    '    Call WriteToTxtFile(frmCSx!OpNote, strPathFileName)
    Else
        MsgBox "ChartPublic-SavesomeFields: " & Err.Number & " - " & Err.Description
        Resume SavesomeFieldsExit
    End If

 

[craigachan]

Just out of curiosity, why do you count the errors? Are you thinking that the error is happening more than once each time SaveSomeFields is running? Once we find out whether this is true, what will be do with that info?

When I put the code is as you suggested, I get the error and it starts to count up and keeps going. I stopped the code at 33 passes and started to step it one line at a time. Then occasionally it would finish out the code without error. Should the last line of your 3186 err code be 'resume' or 'return'?

It errors out at line 'If Not IsNull(frmCSx!OpNote) Then !nNote = temp' (this is in the 'SavRay(23)' area.

I tried putting DoEvents before the this line and after this line, but no changes and the note did not save. When I stepped thru the code line by line in the debugger, occasionally it would save the field as it should.

Does this say anything?

 

[JHB]

...Just out of curiosity, why do you count the errors? Are you thinking that the error is happening more than once each time SaveSomeFields is running? ...

Only for info, only to know how many attempts to write to the record fails.
Yes I expects it would fail more as one time.
You could use it in an If construction to determine how many times the system should try to write to the record.
I just saw, there is an error in where you compare the err number - you have the compare number in a string, that is wrong, (and you've it in more places in your whole project)!

If Err.Number = [B][COLOR=Red]"[/COLOR][/B]3186[B][COLOR=Red]"[/COLOR][/B] Then

it should be

If Err.Number = 3186 Then

I have a question that presses on, why are you using unbound forms?

 

[JHB]

It should be Resume. Then the code returns to where it failed.