Public Function acbWhoHasLockedRecord(frm As Form) As Boolean
' Display a message box that says either:
' -No user has the current record locked, or
' -The user & machine name of the user who
' who has locked the current record.
Dim rst As DAO.recordSet
Dim blnMUError As Boolean
Dim strUser As String
Dim strMachine As String
Dim strMsg As String
On Error GoTo HandleErr
' Default message
strMsg = "Record is not locked by another user."
' Clone the form's recordset and synch up to the
' form's current record
Set rst = frm.RecordsetClone
rst.Bookmark = frm.Bookmark
' If the current record is locked, then the next
' statement should produce an error that we will trap
rst.Edit
ExitHere:
' Display either the default message or one specifying
' the user and machine who has locked the current record.
'MsgBox strMsg, , "Locking Status"
rst.Close
Set rst = Nothing
Exit Function
HandleErr:
' Pass the error to acbGetUserAndMachine which will attempt
' to parse out the user and machine from the error message
If err.Number = 3188 Then
' Locked on this machine.
strMsg = "Some other part of this application " _
& "on this machine has locked this record."
Else
blnMUError = acbGetUserAndMachine(err.description, _
strUser, strMachine)
' If the return value is True, then acbGetUserAndMachine
' was able to return the user and machine name of the user.
' Otherwise, assume the record was not locked.
If blnMUError Then
strMsg = "Record is locked by user: " & strUser & _
vbCrLf & "on machine: " & strMachine & "."
End If
End If
acbWhoHasLockedRecord = True
Resume ExitHere
End Function
Public Function acbGetUserAndMachine(ByVal strErrorMsg As String, _
ByRef strUser As String, ByRef strMachine As String) As Boolean
' Parse out the passed error message, returning
' -True and the user and machine name
' if the record is locked, or
' -False if the record is not locked.
Dim intUserPos As Integer
Dim intMachinePos As Integer
Const USER_STRING As String = " locked by user "
Const MACHINE_STRING As String = " on machine "
acbGetUserAndMachine = False
On Error Resume Next
intUserPos = InStr(strErrorMsg, USER_STRING)
If intUserPos > 0 Then
intMachinePos = InStr(strErrorMsg, MACHINE_STRING)
If intMachinePos > 0 Then
strUser = Mid$(strErrorMsg, _
intUserPos + Len(USER_STRING), _
intMachinePos - (intUserPos + Len(USER_STRING) - 1))
strMachine = Mid$(strErrorMsg, _
intMachinePos + Len(MACHINE_STRING), _
(Len(strErrorMsg) - intMachinePos - _
Len(MACHINE_STRING)))
End If
acbGetUserAndMachine = True
End If
End Function