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.
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: firstname.lastname@example.org 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
Copyright © 1999-2008 by Shamil Salakhetdinov. All rights reserved.