VBA/Excel/Access/Word/Access/Lock

Configuration of LockType as a Property of the Recordset Object

 
Sub OptimisticRecordset()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.LockType = adLockOptimistic
    rst.Open "Select * from Employees"
    rst("City") = "Village"
    rst.Update
    Debug.Print rst("City")
    rst.Close
    Set rst = Nothing
End Sub

Default Record Locking

 
Sub SetLocking()
    Application.SetOption "Default Record Locking", 2
End Sub

Set and get the lock type

 
Sub SetAndGetLocking(strLockType As String)
    Dim intLockIndex As Integer
    Dim strLockDesc As String
    Select Case strLockType
        Case "Optimistic"
            intLockIndex = 6
        Case "Exclusive"
            intLockIndex = 1
        Case "Pessimistic"
            intLockIndex = 2
        Case Else
            intLockIndex = -1
    End Select
    If intLockIndex <> -1 Then
        Application.SetOption "Default Record Locking", intLockIndex
    End If
    Select Case Application.GetOption("Default Record Locking")
        Case 0
            MsgBox "The default locking method is optimistic."
        Case 1
            MsgBox "The default locking method is exclusive."
        Case 2
            MsgBox "The default locking method is pessimistic."
    End Select
End Sub

Set Lock Type to adLockOptimistic

 
Sub SupportsMethod()
    "Declare and instantiate a Recordset object
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.LockType = adLockOptimistic
    rst.CursorLocation = adUseServer
    "Open the recordset, designating that the source
    "is a SQL statement
    rst.Open Source:="Select * from Employees ", _
        Options:=adCmdText
    "Determine whether the recordset supports certain features
    Debug.Print "Bookmark " & rst.Supports(adBookmark)
    Debug.Print "Update Batch " & rst.Supports(adUpdateBatch)
    Debug.Print "Move Previous " & rst.Supports(adMovePrevious)
    Debug.Print "Seek " & rst.Supports(adSeek)
    rst.Close
    Set rst = Nothing
End Sub

use optimictic lock to open recordset

 
Private Sub Form_Open(Cancel As Integer)
    Dim con As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strFrmNm As String
    
    Set myRecordset = New ADODB.Recordset
    Set con = New ADODB.Connection
    
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\store.mdb;"
       
    myRecordset.Open "SELECT * FROM Employees", con, adOpenKeyset, adLockOptimistic
    Set Me.Recordset = myRecordset
    
    myRecordset.Close
    con.Close
    Set myRecordset = Nothing
    Set con = Nothing
End Sub

Use Row Level Locking

 
Sub SetGranularity()
    Application.SetOption "Use Row Level Locking", True
End Sub