ADO Error Saving Memo Field (1 Viewer)

winshent · Jun 8, 2015

In my dataset which lists configurations, some records contain up to 6000 character configuration strings in a Memo field (named 'PermissionString').

The Memo string is hashed and saved to another field for joining to other tables.

The configurations are displayed on a continuous form with all fields locked for editing. Each record on the form has an edit button. The edit button populates the information of the particular record to an unbound form for the user to edit. This edit form also contains validation. Whilst editing, the continuous form is not closed.

ERROR: -2147217887
Could not update; currently locked by another session on this machine.

This code behind the edit form fails when saving to the PermissionString field (memo field).

If I comment the line, then the record saves fine.

Any ideas ?

Code:

Private Function mblnSaveRecord()
    On Error GoTo PROC_ERR

    Dim blnReturn As Boolean

    Dim objConn As ADODB.Connection
    Dim objRst As New ADODB.Recordset
    Dim strSQL As String
    
    Dim strPermissionString As String
    
    Set objConn = CurrentProject.Connection
    
    strSQL = ""
    strSQL = strSQL & "SELECT PermissionString, Access, Hash, Dataset, ArchivedDate, IIf(IsNull([Archiveddate]),0,1) AS Archived  "
    strSQL = strSQL & "  FROM ProfileMapping "
    strSQL = strSQL & " WHERE ProfileID =" & gudtProfile.ProfileID
    
    objRst.Open strSQL, objConn, adOpenStatic, adLockPessimistic
    
    With objRst
        If gudtProfile.ProfileID = 0 Then
            ' add new record
            .AddNew
                !Access = txtAccess.value
                strPermissionString = Trim(txtPermissionString.value)
                !Dataset = cboDataset.value
                !PermissionString = strPermissionString
                !Hash = MD5_string(strPermissionString)
            .Update
        Else
            If Not .EOF Then
                
                !Access = txtAccess.value
                strPermissionString = Trim(txtPermissionString.value)
                !Dataset = cboDataset.value
                !PermissionString = strPermissionString
                !Hash = MD5_string(strPermissionString)
                
                If chkArchive = True And gudtProfile.ArchivedDate = 0 Then
                    If vbYes = MsgBox("Are you sure you want to archive this record", vbYesNo, "ARCHIVE RECORD ?") Then
                        !ArchivedDate = Now
                    End If
                    
                ElseIf chkArchive = False And gudtProfile.ArchivedDate <> 0 Then
                    If vbYes = MsgBox("Are you sure you want to restore this record", vbYesNo, "RESTORE RECORD ?") Then
                        !ArchivedDate = Null
                    End If
                End If
                
                .Update
            End If
        End If
    End With
    
    Forms!frmProfiles.Requery
    
    blnReturn = True
    
PROC_EXIT:
    On Error Resume Next
    objRst.Close
    Set objRst = Nothing
    objConn.Close
    Set objConn = Nothing
    
    mblnSaveRecord = blnReturn
    Exit Function
    
PROC_ERR:
    MsgBox Err.Number & vbNewLine & Err.Description
    blnReturn = False
    Resume PROC_EXIT

End Function

Ranman256 · Jun 8, 2015

Instead of using code, did you try using
append query for new recs?
update query for existing recs?

Privateer · Jun 8, 2015

I am making an educated guess here because I have run into a problem with long strings that are queries. The VBA "page" where the code is written has screwed up my queries when they are assigned to a variable and the length exceeds the "page" width. Try this. don't assign the string to a variable just slam it into the field.
!PermissionString = Trim(txtPermissionString.value)

vbaInet · Jun 8, 2015

Ranman256 said:
Instead of using code, did you try using
append query for new recs?
update query for existing recs?

That's definitely a good option and preferred to ADO.

Also, if you were going to do any data manipulation on an Access backend you should be using DAO instead of ADO.

How are you locking the main form? And why specify a pessimistic lock? You should also specify a cursor location too.

Now, if the form is bound to the SELECT clause you mentioned in your post, you can do it the DAO way like this (aircode):

Code:

Set obJRst = Me.RecordsetClone
Set objRst.Bookmark = Me.Bookmark

With objRst
    .LockEdits = True    <--- pessimistic
    ... your edit code ...
End With

By the way, is your Hash() function also using recordsets or just doing an MD5Sum?

winshent · Jun 9, 2015

Ranman256 said:
Instead of using code, did you try using
append query for new recs?
update query for existing recs?

Never used this method.. Quite a messy way of doing things and would have to be rewritten if splitting data out to a seperate data file (we dont do linked tables here as network performance is so bad).. Also need to handle apostraphes etc...

Privateer said:
I am making an educated guess here because I have run into a problem with long strings that are queries. The VBA "page" where the code is written has screwed up my queries when they are assigned to a variable and the length exceeds the "page" width. Try this. don't assign the string to a variable just slam it into the field.
!PermissionString = Trim(txtPermissionString.value)

Tried this initally.. Didnt work hence trying writing to a variable first.

vbaInet said:
That's definitely a good option and preferred to ADO.

Also, if you were going to do any data manipulation on an Access backend you should be using DAO instead of ADO.

How are you locking the main form? And why specify a pessimistic lock? You should also specify a cursor location too.

Now, if the form is bound to the SELECT clause you mentioned in your post, you can do it the DAO way like this (aircode):

Code:

Set obJRst = Me.RecordsetClone Set objRst.Bookmark = Me.Bookmark With objRst .LockEdits = True <--- pessimistic ... your edit code ... End With

By the way, is your Hash() function also using recordsets or just doing an MD5Sum?

Yes the MD5 is not using recordset... just some code i pinched from here:
http://www.di-mgt.com.au/src/basMD5.bas.html

Think I am going to have to look at DAO. Always used it in the past but its not 'the way its done here'...

Will also play around with lock type and cursor to see if i get anywhere with that..

Cheers guys...

vbaInet · Jun 9, 2015

winshent said:
Never used this method.. Quite a messy way of doing things and would have to be rewritten if splitting data out to a seperate data file (we dont do linked tables here as network performance is so bad).. Also need to handle apostraphes etc...

Don't worry, you won't need to and here's an example:

Code:

strSQL = "UPDATE TableName " & _
	 "SET 	 Field = Forms!FormName!FieldOrControl " & _
	 "WHERE	 SomeCriteria;"

db.Execute strSQL, dbFailOnError

Notice that the reference to the field/control is inside the quotes in which case Access will handle the data being passed, but you will need to Format the Control to the appropriate data type.

If you don't want to format the control then an even better option would be to put that whole statement in a query, add to the Parameters list the field/control reference with the appropriate data type and execute your query.

winshent · Jun 9, 2015

I've changed the code to use DAO but still have a similar problem..

ERROR: 3188
Could not update; currently locked by another session on this machine.

Error is strange as I'm running this on my C Drive..

I've checked the properties on the continuous form as mentioned above...
Recordset Type = Dynaset
Record Locks = No Locks

Confused !!

vbaInet · Jun 9, 2015

Have you got any other "active" recordsets or perhaps hidden forms bound to the same record source?

Let's see the code.

vbaInet · Jun 9, 2015

Here are two suggestions which should help:

1. Going back to the ADO code, explicitly set the cursor location to adUseClient
2. With the DAO/ADO code, update all the fields minus the memo field, stay on that record and finally update the memo field alone.

winshent · Jun 9, 2015

'frmProfiles' (Continuous Form) bound to the following SQL:

Code:

SELECT Dataset, ArchivedDate, ProfileID, PermissionString, Access, Hash, IIf(IsNull([Archiveddate]),0,1) AS Archived 
  FROM ProfileMapping 
 ORDER BY Dataset, ArchivedDate, Access;

Edit button on 'frmProfiles' opens 'frmProfiles_Save' (Unbound Form)...

vbaInet · Jun 9, 2015

Sorry, I meant let's see your DAO code. Also try the suggestions above which you may have missed.

winshent · Jun 9, 2015

vbaInet said:
Here are two suggestions which should help:

1. Going back to the ADO code, explicitly set the cursor location to adUseClient
2. With the DAO/ADO code, update all the fields minus the memo field, stay on that record and finally update the memo field alone.

Tried altering the ADO code as suggested... Still same error..

Code:

Private Function mblnSaveRecord() As Boolean
    On Error GoTo PROC_ERR

    Dim blnReturn As Boolean

    Dim objConn As ADODB.Connection
    Dim objRst As New ADODB.Recordset
    Dim strSQL As String
    
    Dim strPermissionString As String
    
    Set objConn = CurrentProject.Connection
    
    strSQL = ""
    strSQL = strSQL & "SELECT PermissionString, Access, Hash, Dataset, ArchivedDate, IIf(IsNull([Archiveddate]),0,1) AS Archived  "
    strSQL = strSQL & "  FROM ProfileMapping "
    strSQL = strSQL & " WHERE ProfileID =" & gudtProfile.ProfileID
    
    objRst.CursorLocation = adUseClient
    objRst.Open strSQL, objConn, adOpenDynamic, adLockOptimistic
    
    
    With objRst
        If gudtProfile.ProfileID = 0 Then
            ' add new record
            .AddNew
                !Access = txtAccess.value
                strPermissionString = Trim(txtPermissionString.value)
                !Dataset = cboDataset.value
                !PermissionString = strPermissionString
                !Hash = MD5_string(strPermissionString)
            .Update
        Else
            If Not .EOF Then
                .MoveFirst
                
                !Access = txtAccess.value
                ' strPermissionString = Trim(txtPermissionString.value)
                !Dataset = cboDataset.value
                '!PermissionString = strPermissionString
                !PermissionString = Trim(txtPermissionString.value)
                !Hash = MD5_string(strPermissionString)
                
                If chkArchive = True And gudtProfile.ArchivedDate = 0 Then
                    If vbYes = MsgBox("Are you sure you want to archive this record", vbYesNo, "ARCHIVE RECORD ?") Then
                        !ArchivedDate = Now
                    End If
                    
                ElseIf chkArchive = False And gudtProfile.ArchivedDate <> 0 Then
                    If vbYes = MsgBox("Are you sure you want to restore this record", vbYesNo, "RESTORE RECORD ?") Then
                        !ArchivedDate = Null
                    End If
                End If
                
                .Update
            End If
        End If
    End With
    
    Forms!frmProfiles.Requery
    
    blnReturn = True
    
PROC_EXIT:
    On Error Resume Next
    objRst.Close
    Set objRst = Nothing
    objConn.Close
    Set objConn = Nothing
    
    mblnSaveRecord = blnReturn
    Exit Function
    
PROC_ERR:
    Debug.Print Err.Number & vbNewLine & Err.Description
    MsgBox Err.Number & vbNewLine & Err.Description
    
    blnReturn = False
    Resume PROC_EXIT

End Function

winshent · Jun 9, 2015

vbaInet said:
Sorry, I meant let's see your DAO code. Also try the suggestions above which you may have missed.

DAO code...

Code:

Private Function mblnSaveRecordDAO() As Boolean
    On Error GoTo PROC_ERR

    Dim blnReturn As Boolean

    Dim db As DAO.Database
    Dim objRst As DAO.Recordset
    Dim strSQL As String
    
    Dim strPermissionString As String
    
    Set db = CurrentDb
    
    strSQL = ""
    strSQL = strSQL & "SELECT PermissionString, Access, Hash, Dataset, ArchivedDate, IIf(IsNull([Archiveddate]),0,1) AS Archived  "
    strSQL = strSQL & "  FROM ProfileMapping "
    strSQL = strSQL & " WHERE ProfileID =" & gudtProfile.ProfileID
    
    Set objRst = db.OpenRecordset(strSQL, dbOpenDynaset)
    
    With objRst
        If gudtProfile.ProfileID = 0 Then
            ' add new record
            .AddNew
                !Access = txtAccess.value
                strPermissionString = Trim(txtPermissionString.value)
                !Dataset = cboDataset.value
                !PermissionString = strPermissionString
                !Hash = MD5_string(strPermissionString)
            .Update
        Else
            If Not .EOF Then
                .MoveFirst
                
                .Edit
                    !Access = txtAccess.value
                    strPermissionString = Trim(txtPermissionString.value)
                    !Dataset = cboDataset.value
                    !PermissionString = strPermissionString
                    !Hash = MD5_string(strPermissionString)
                    
                    If chkArchive = True And gudtProfile.ArchivedDate = 0 Then
                        If vbYes = MsgBox("Are you sure you want to archive this record", vbYesNo, "ARCHIVE RECORD ?") Then
                            !ArchivedDate = Now
                        End If
                        
                    ElseIf chkArchive = False And gudtProfile.ArchivedDate <> 0 Then
                        If vbYes = MsgBox("Are you sure you want to restore this record", vbYesNo, "RESTORE RECORD ?") Then
                            !ArchivedDate = Null
                        End If
                    End If
                
                .Update
            End If
        End If
    End With
    
    Forms!frmProfiles.Requery
    
    blnReturn = True
    
PROC_EXIT:
    On Error Resume Next
    objRst.Close
    Set objRst = Nothing
    Set db = Nothing
    
    mblnSaveRecordDAO = blnReturn
    Exit Function
    
PROC_ERR:
    Debug.Print Err.Number & vbNewLine & Err.Description
    MsgBox Err.Number & vbNewLine & Err.Description
    
    blnReturn = False
    Resume PROC_EXIT

End Function

vbaInet · Jun 9, 2015

Ok, I think you would have to use AppendChunk for this one. Here's an example:

Code:

    Dim db      As DAO.Database
    Dim rs      As DAO.Recordset
    Dim strMem  As String
    Dim lngSize As Long
    
    Const STR_SQL As String = "SELECT ...etc"
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset(strSql, dbOpenDynaset, dbFailOnError, dbPessimistic)
    
    With rs
        lngSize = .Fields("[COLOR="Blue"]MemoField[/COLOR]").FieldSize
        strMem = .Fields("[COLOR="blue"]MemoField[/COLOR]").GetChunk(0, lngSize)
        strMem = strMem & vbNewLine & "New string"

        .Edit
        !Field1 = "Value"
        !Field2 = "Value"
        .Fields("[COLOR="blue"]MemoField[/COLOR]").AppendChunk strMem
        .Update
    End With
    
    strMem = vbNullString
    Set rs = Nothing
    Set db = Nothing

winshent · Jun 10, 2015

vbaInet said:

Ok, I think you would have to use AppendChunk for this one. Here's an example:

Code:

    Dim db      As DAO.Database
    Dim rs      As DAO.Recordset
    Dim strMem  As String
    Dim lngSize As Long
    
    Const STR_SQL As String = "SELECT ...etc"
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset(strSql, dbOpenDynaset, dbFailOnError, dbPessimistic)
    
    With rs
        lngSize = .Fields("[COLOR="Blue"]MemoField[/COLOR]").FieldSize
        strMem = .Fields("[COLOR="blue"]MemoField[/COLOR]").GetChunk(0, lngSize)
        strMem = strMem & vbNewLine & "New string"

        .Edit
        !Field1 = "Value"
        !Field2 = "Value"
        .Fields("[COLOR="blue"]MemoField[/COLOR]").AppendChunk strMem
        .Update
    End With
    
    strMem = vbNullString
    Set rs = Nothing
    Set db = Nothing

Hi

tried this example... this is my code (DAO).. still get the error

Code:

.Edit
    !Access = txtAccess.value
    strPermissionString = Trim(txtPermissionString.value)
    !Dataset = cboDataset.value
    .Fields("PermissionString").AppendChunk strPermissionString
    !Hash = MD5_string(strPermissionString)

ERROR: 3188
Could not update; currently locked by another session on this machine.

vbaInet · Jun 10, 2015

winshent said:

Code:

.Edit
    !Access = txtAccess.value
    strPermissionString = Trim(txtPermissionString.value)
    !Dataset = cboDataset.value
[COLOR="Red"]    .Fields("PermissionString").AppendChunk strPermissionString[/COLOR]
    !Hash = MD5_string(strPermissionString)

This fyi, you will notice in my example that I'm using GetChunk() before AppendChunk() because the first call to AppendChunk will overwrite what is stored in your memory. Consecutive calls within the edit will append to the memo. So take note.

But that's quite bizarre anyway winshent! Can you upload a mock up db for me?

winshent · Jun 30, 2015

Still struggling with this... anyone else have ideas ?

ETA, didnt realise you had responded again as it rolled over to 2nd page vbaInet...

I've been looking at this example...
http://swansonsoftware.com/acme/default.asp

I'll spend a bit more time on this now and post with my findings...

vbaInet · Jul 3, 2015

I don't see why it would not work, but as already requested, upload a cut-down version so I can have a look.

winshent · Aug 12, 2015

So i could never get this working without closing the bound form frmProfiles first..

Cheers VBAInet for your help.. I can't upload a copy here as it will be flagged as a security breach.

winshent · Sep 18, 2015

I finally managed to get some time on this (I'm moving across to a Cognos TM1 developer role) and get this working using ADO parameters...

Took some inspiration from the following thread..
http://www.access-programmers.co.uk/forums/showthread.php?t=219149

Seems to work quite well.. although need to push it out to the users..

Here is my code..

Should the parameter objects be recycled at the end ?

Code:

Private Function mblnSaveRecordADOParams() As Boolean
    On Error GoTo PROC_ERR

    Dim blnReturn As Boolean

    Dim objCmd As ADODB.Command
    Dim strSQL As String

    Dim objPrmPermissionString As ADODB.Parameter
    Dim objPrmAccess As ADODB.Parameter
    Dim objPrmHash As ADODB.Parameter
    Dim objPrmDataset As ADODB.Parameter
    Dim objPrmArchiveDate As ADODB.Parameter
        
    Set objCmd = New ADODB.Command
    
    With objCmd
        .ActiveConnection = CurrentProject.Connection
        .CommandType = adCmdText
        
        Set objPrmPermissionString = .CreateParameter("pPermissionString", adVarChar, adParamInput, 32767, Trim(txtPermissionString.value))
        .Parameters.Append objPrmPermissionString
        
        Set objPrmAccess = .CreateParameter("pAccess", adVarChar, adParamInput, 255, txtAccess.value)
        .Parameters.Append objPrmAccess
        
        Set objPrmHash = .CreateParameter("pHash", adVarChar, adParamInput, 255, MD5_string(Trim(txtPermissionString.value)))
        .Parameters.Append objPrmHash
        
        Set objPrmDataset = .CreateParameter("pDataset", adVarChar, adParamInput, 255, cboDataset.value)
        .Parameters.Append objPrmDataset
        
        If gudtProfile.ProfileID = 0 Then
            ' add new record
            
            strSQL = ""
            strSQL = strSQL & " INSERT INTO ProfileMapping ( PermissionString, Access, Hash, Dataset ) "
            strSQL = strSQL & " VALUES ( pPermissionString, pAccess, pHash, pDataset )"
            
            .CommandText = strSQL
            .Execute
                        
        Else
            ' edit existing record
            
            strSQL = ""
            strSQL = strSQL & "UPDATE ProfileMapping " & vbNewLine
            strSQL = strSQL & "   SET PermissionString = pPermissionString " & vbNewLine
            strSQL = strSQL & "       , Access = pAccess " & vbNewLine
            strSQL = strSQL & "       , Hash = pHash " & vbNewLine
            strSQL = strSQL & "       , Dataset = pDataset " & vbNewLine
            
            ' Check if ArchiveDate needs to be updated. If so the add to SQL statement and create
            If chkArchive = True And gudtProfile.ArchivedDate = 0 Then
                If vbYes = MsgBox("Are you sure you want to archive this record", vbYesNo, "ARCHIVE RECORD ?") Then
                    
                    strSQL = strSQL & "       , ArchivedDate = pArchivedDate " & vbNewLine
                    
                    objPrmArchiveDate = .CreateParameter("pArchiveDate", adDate, adParamInput)
                    objPrmArchiveDate = Now
                    .Parameters.Append objPrmArchiveDate
                
                End If
                
            ElseIf chkArchive = False And gudtProfile.ArchivedDate <> 0 Then
                If vbYes = MsgBox("Are you sure you want to restore this record", vbYesNo, "RESTORE RECORD ?") Then
                    
                    strSQL = strSQL & "       , ArchivedDate = pArchivedDate " & vbNewLine
                    
                    objPrmArchiveDate = .CreateParameter("pArchiveDate", adDate, adParamInput)
                    objPrmArchiveDate = Null
                    .Parameters.Append objPrmArchiveDate
                    
                End If
            End If
            
            strSQL = strSQL & " WHERE ProfileID =" & gudtProfile.ProfileID
            
            Debug.Print strSQL
            .CommandText = strSQL
            .Execute
        
        End If
        
    End With
    
    blnReturn = True
            
PROC_EXIT:
    On Error Resume Next
    
    Set objCmd = Nothing
        
    mblnSaveRecordADOParams = blnReturn
    Exit Function
    
PROC_ERR:
    Debug.Print Err.Number & vbNewLine & Err.Description
    MsgBox Err.Number & vbNewLine & Err.Description
    
    blnReturn = False
    Resume PROC_EXIT
    
End Function

ADO Error Saving Memo Field (1 Viewer)

Registered User.

Well-known member

Registered User.

AWF VIP

Registered User.

AWF VIP

Registered User.

AWF VIP

AWF VIP

Registered User.

AWF VIP

Registered User.

Registered User.

AWF VIP

Registered User.

AWF VIP

Registered User.

AWF VIP

Registered User.

Registered User.

Similar threads

Users who are viewing this thread