ADO error 3251

[Fattiger]

Hi Guys,

this is my first thread in this forum, please apologize upfront, if I am behaving stupid.

My question is on the borderline area of Access and Excel, therefore I hope someone can help me.

While I feel quite comfortable programming VBA code in Excel, I am an absolute novice in Access, let alone ADO. Still I have developed a tool using an Excel Frontend to an ACCDB database stored on a sharepoint. Except for the slow performance during Open Connection and close Connection the tool works quite nicely for more than 50 users. Unfortunately there are a few users who always receive a 3251 error when the macro is trying to update some data in the database.

1. What do I need to do to stop that error from occuring?
2. Can I leave the connection to the database open after the update or will this cause some locks for other users?

My Macro looks like that (I hope I did not built extra errors when I simplified it for this thread )

Sub Update_Records_from_Excel_in_Access()
    Dim Filterstring, Fieldstring As String
    Dim r As Long
    Dim DB_DatasourceString As String
    Dim Conflict As Boolean
    Dim dsheet As Worksheet
    Dim ChangeCounter As Integer
   
    DB_DatasourceString = "Data Source=" & GenFileSet.Range("c8").Value & GenFileSet.Range("c9") _
 _
.Value & Chr(59) & "Jet OLEDB:Database Password=PW" & Chr(59)

    ' connect to the Access database
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & DB_DatasourceString

     ' open a recordset
    Set rs = New ADODB.Recordset
rs.CursorLocation=adUseServer
    rs.Open "DATA", cn, adOpenKeyset, adLockPessimistic, adCmdTable
    r = 10    ' the start row in the worksheet
    Set dsheet = Data
    Do While Len(Data.Range("C" & r).Formula) > 0    ' repeat until first empty cell in spalt C
        Filterstring = "DB_AutoID = " & Chr(39) & Data.Cells(r, 3).Value & Chr(39)    '
        rs.Filter = Filterstring
        For j = 2 To 97
            On Error Resume Next
            Fieldstring = FieldContent(Data.Cells(1, j).Value)
            If Err.Number <> 0 Then
                Fieldstring = ""
                Err.Clear
            End If
            On Error GoTo errorhandler
            If Fieldstring <> Data.Cells(r, j).Value Then
                'XXXXXXX in der nächsten Zeile kommt es bei bestimmten Users zu Fehler  3251
                rs.Fields(tbl_col_matrix.Cells(COlRow + 3, j).Value) = Data.Cells(r, j).Value
                'XXXXXXX 
                ChangeCounter = ChangeCounter + 1
                Err.Clear
            End If
        Next j

        If ChangeCounter > 0 Then
                 rs.Update    ' stores the changed record
        End If
        r = r + 1    ' next row
    Loop
    Data.Protect "PW", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=  _
_
True
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub



Public Function FieldContent(DBField As Field) As Variant
    Dim dbInteger As Integer
    Dim dbLong As Long
    Dim dbBoolean As Boolean
    If IsNull(DBField.Value) Then
        If DBField.Type = dbInteger Or DBField.Type = dbLong Then
            FieldContent = 0
        ElseIf DBField.Type = dbBoolean Then
            FieldContent = False
        Else
            FieldContent = ""
        End If
    Else
        FieldContent = DBField.Value
    End If
End Function

Thanks for your help

Theo