Alert for locked record

Question

On a form whose locking is set to "Edited Record", is it possible to determine which records in the underlying table/query are locked so that a user who tries to edit a locked record could be given a message box with an explanation?

My problem is that I'm not too well versed in dealing directly with functions so I'm not sure about how to call it. Could you give me a small example of how I supply the recordset to it and the such? I am trying to call it when a user enters a Customer ID in a text box to look up a particular customer, but it is possible that the record they are requesting may be being edited by another user. That's when I'd like to give the alert.

Answer

From: Shamil Salakhetdinov <shamil@marta.darts.spb.ru>
Subject: Re: Alert for locked record?
Date: 23 April 1998 15:20

Michael,

Here is another variant of your sample in my interpretation which accepts both form and recordset object refs:

Function smsCurrRowIsLocked(ByRef robj As Variant, _
                            ByRef rstrUserName As String, _
                            ByRef rstrMachineName As String)
' Accepts: an (variant) object reference which can be opened editable recordset or
'          opened editable form and two string variables
' Purpose: determines if the current record in robj is locked,
'          and if so who has it locked
' Returns: True if current record is locked (and sets rstrUserName and
'          rstrMachineName to the user with the lock).
'          False if the record isn't locked.
'
' From:    Building Applications Chapter 12 &
'          Shamil Salakhetdinov, e-mail: shamil@marta.darts.spb.ru

    Dim strErrorString As String
    Dim strMachineNameStart As Integer
    Dim rst As Recordset
    
    smsCurrRowIsLocked = False
    
    On Error GoTo smsCurrRowIsLocked_Err
    
    If TypeName(robj) = "Recordset" Then
        Set rst = robj
    ElseIf Left(TypeName(robj), 4) = "Form" Then
        Set rst = robj.RecordsetClone
        rst.Bookmark = robj.Bookmark
    Else
      Err.Raise 503 + vbObjectError, "smsCurrRowIsLocked", _
                "Invalid parameter TypeName(robj) = " & TypeName(robj)
    End If
    
    rst.Edit                    'Try to edit the current record in the recordset.
    rst.CancelUpdate

smsCurrRowIsLocked_Exit:
    Exit Function

smsCurrRowIsLocked_Err:
    If Err = 3260 Then          ' Record is locked -- parse error string.
        strErrorString = Err.Description
        rstrUserName = Mid$(strErrorString, 44, InStr(44, strErrorString, "'") - 44)
        strMachineNameStart = InStr(43, strErrorString, " on machine ") + 13
        rstrMachineName = Mid$(strErrorString, strMachineNameStart, _
                         Len(strErrorString) - strMachineNameStart - 1)
        smsCurrRowIsLocked = True
    ElseIf Err = 3188 Then      ' record is locked by another session
        rstrUserName = CurrentUser()
        rstrMachineName = "Your PC"
        smsCurrRowIsLocked = True
    ElseIf Err = 3027 Then
        'Can't update.  Database or object is read-only.
    End If
    Resume smsCurrRowIsLocked_Exit

End Function

You can call this function from CustomerId textbox's BeforeUpdate event (I assume that CustimerId has
type = Number(Long)):

Private Sub txtCustomerId_BeforeUpdate(Cancel As Integer)
    Dim strMachineName  As String
    Dim strUserName As String
    
    Dim rst As Recordset
    Dim strCtlName As String
    Dim strTableName As String
    Dim strIdFieldName As String
    Dim strSql As String
    
    strCtlName = "txtCustomerId"
    strTableName = "tblCustomer"
    strIdFieldName = "CustomerId"
    
    strSql = "Select [" & strIdFieldName & "] from [" & _
           strTableName & "] where ([" & strIdFieldName & "] = " & _
           Me(strCtlName) & ")"
    Set rst = CodeDb().OpenRecordset(strSql, dbOpenDynaset)
    If Not rst.EOF Then
        rst.MoveFirst
        
        If smsCurrRowIsLocked(rst, strUserName, strMachineName) Then
           MsgBox "Customer row is locked by user '" & strUserName & _
               "' on machine '" & strMachineName & "'", vbExclamation + vbOKOnly
           Cancel = True
        End If
    End If
End Sub

You can call it also (but this isn't your case) from form's KeyDown event (don't forget to set KeyPreview=Yes) this way (you'd probably will need to bypass it when Special keys are pushed):

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim strMachineName  As String
    Dim strUserName As String
    
    If smsCurrRowIsLocked(Me, strUserName, strMachineName) Then
          MsgBox "Current row is locked by user '" & strUserName & _
               "' on machine '" & strMachineName & "'", vbExclamation + vbOKOnly
    End If
End Sub

HTH,
Shamil