Beispiel:

Public Function A2XWhoHasLockedRst(pFrm As Form) As Boolean
  '// =====================================================
  '// Methode   | Überprüft, ob der aktuelle DS im Formular
  '               für die Bearbeitung gesperrt ist
  '// -----------------------------------------------------
  '// Parameter | pfrm   - aktuelle Form
  '// -----------------------------------------------------
  '// Rückgabe  | Boolean - True=gesperrt
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispielaufruf: z.B. über eine Befehlsschaltfläche
  '// Beim Klicken: =A2XWhoHasLockedRst(Formulare([Name]))
  '// =====================================================
 
  Dim rst As DAO.Recordset
  Dim blnMUError As Boolean
  Dim sUser As String
  Dim sMachine As String
  Dim sMsg As String
 
  On Error GoTo HandleErr
 
  ' Standardnachricht
  sMsg = "Datensatz ist derzeit nicht gesperrt!"
 
  ' Dupliziere die Datensatzherkunft des Formulars und
  ' setze ein Lesezeichen auf den aktuellen Datensatz
  Set rst = pFrm.RecordsetClone
  rst.Bookmark = pFrm.Bookmark
 
  ' Falls der aktuelle Datensatz gesperrt ist, folgt hier
  ' an nächster Stelle ein Fehler den wir in der Fehler-
  ' behandlung abhandeln
  rst.Edit
 
ExitHere:
  ' Gebe Prüfstatus aus!
  MsgBox sMsg, vbInformation, "Sperr-Status"
  If Not rst Is Nothing Then rst.Close: Set rst = Nothing
  Exit Function
 
HandleErr:
  ' Überprüfe die Fehlermeldung und geben ggf. den
  ' Name des Benutzer aus, falls zu ermitteln ist
  If Err.Number = 3188 Then
    ' DS gesperrt durch den Computer / der Applikation
    sMsg = "Datensatz wurde durch einen anderen Bereich " _
           & "innerhalb der Anwendung gesperrt."
    A2XWhoHasLockedRst = True
  Else
    sMsg = "Problem: Fehler " & Err.Number & vbCrLf & _
           Err.Description
    blnMUError = A2XGetUserMachine(Err.Description, _
                                   sUser, sMachine)
    ' Wenn die Rückgabe wahr ist, konnte die Funktion
    ' A2XGetUserMachine ermitteln, wer den Datensatz
    ' gesperrt hat. Falls nicht, ist der Datensatz nicht
    ' gesperrt und ein anderes Problem ist aufgetreten
    If blnMUError Then
      sMsg = "Datensatz derzeit gesperrt von: " & sUser & _
             vbCrLf & "am Computer: " & sMachine & "."
      A2XWhoHasLockedRst = True
    End If
  End If
  Resume ExitHere
End Function
 
Public Function A2XGetUserMachine(ByVal psErrMsg As String, _
                                  ByRef psUser As String, _
                                  ByRef psMachine As String) _
                                  As Boolean
  '// =====================================================
  '// Methode   | Hilfsfunktion, um den Benutzer ggf. aus
  '               der Fehlermeldung zu ermitteln.
  '// -----------------------------------------------------
  '// Parameter | psErrMsg  - Fehlermeldung
  '               psUser    - Leerstring für die Übergabe
  '               psMachine - dito s.o.
  '// -----------------------------------------------------
  '// Rückgabe  | Boolean - Ja/gesperrt Nein/frei
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// =====================================================
 
  Dim iUserPos As Integer
  Dim iMachinePos As Integer
 
  Const csUSER_STRING As String = " von Benutzer "
  Const csMACHINE_STRING As String = " auf Computer "
 
   On Error GoTo A2XGetUserMachine_Error
 
  A2XGetUserMachine = False
 
  On Error Resume Next
  iUserPos = InStr(psErrMsg, csUSER_STRING)
  If iUserPos > 0 Then
    iMachinePos = InStr(psErrMsg, csMACHINE_STRING)
    If iMachinePos > 0 Then
      psUser = Mid$(psErrMsg, _
                    iUserPos + Len(csUSER_STRING), _
                    iMachinePos - (iUserPos + Len(csUSER_STRING) - 1))
      psMachine = Mid$(psErrMsg, _
                       iMachinePos + Len(csMACHINE_STRING), _
                       (Len(psErrMsg) - iMachinePos - _
                        Len(csMACHINE_STRING)))
    End If
    A2XGetUserMachine = True
  End If
 
A2XGetUserMachine_Exit:
   On Error GoTo 0
   Exit Function
 
A2XGetUserMachine_Error:
  Select Case Err.Number
    Case Else
      MsgBox "Fehler " & Err.Number & ": " & _
             Err.Description, vbCritical, _
             "modData.A2XGetUserMachine"
  End Select
  Resume A2XGetUserMachine_Exit
 
End Function