Errore runtime 3197

Nella pricedura che segue, non riesco a venire a capo dell'errore 3197 (The Microsoft Office Access database engine stopped the process because you and another user are attempting to change the same data at the same time) sulla riga .update. Come si vede, la procedura modifica una data (in formato yyyymmdd) nel campo Testo e tenta di riscrivere il record modificato. Notare che essendo in test sono sicuramente l'unico user a lavorare su questo database, quindi non so a cosa imputare l'errore.

Sub modifyExpDate()


'Questa procedura modifica la data di scadenza del GP nei record della tabella Eventi di Hyperpower
'I dati trasferiti sono limitati ai record
'contenenti il codice GP e sono ordinati per numero evento

    
    Dim SQLStr As String
    Dim rs As DAO.Recordset
    Dim DataOld As String, DataNew As String, anno As String, mese As String, giorno As String
    
       
     SQLStr = "SELECT * FROM [HPEventi] WHERE Testo LIKE '%GP%' ORDER BY IDEvento"
'
    Set rs = CurrentDb.OpenRecordset(SQLStr, dbOpenDynaset, dbSeeChanges)
    
    'For each record in recordset we must isolate the date, format yyyymmdd, and add
    ' three months to it, then we write the record back
    
    With rs
        .MoveFirst
       Do While Not .EOF
         '   extract date
            DataOld = Mid(!testo, 10, 8)
            anno = Left(DataOld, 4)
            mese = Mid(DataOld, 5, 2)
            giorno = Right(DataOld, 2)
        ' incremento mese
            mese = mese + 3
        ' se mese > 12, incremento anno e prendo mese modulo 12
            If mese > 12 Then
                mese = mese Mod 12
                anno = anno + 1
            End If
        ' in ogni caso, formattiamo per leading zeroes
            mese = Format(mese, "00")
            giorno = Format(giorno, "00")
        ' ricostruiamo la data
            DataNew = anno & mese & giorno
        ' sostituiamo nel record
            .Edit
            !testo = Replace(!testo, DataOld, DataNew)
         
        .Update         '<==== qui c'è l'errore
        .MoveNext
       
        Loop
    End With
    
'            Tidy up
    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing
End Sub

Grazie per qualsiasi idea.