Valores únicos usando el formulario de acceso

'*************** Code Start *****************************************************
' Purpose  : test for unique value using control BeforeUpdate event
'            if not unique, move to other record or stay and edit
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'-------------------------------------------------------------------------------

Private Sub MyControlname_BeforeUpdate(Cancel As Integer) 
's4p 221101 ... 11
'make sure value is unique on new or modified record
'  if not string, then modify delimiter too
'lookup table design: ideally there will be a Unique Index
'  on the value to lookup that isn't to be duplicated
'  but not necessary for this procedure to work
'assumes Value is a string and primary key (PK) is a long integer
'written generically so MyControlname will be different for you!!

   'dimension variables
   Dim nRecordID As Long _ 
      ,sWhere As String _ 
      ,sValue As String _ 
      ,sMsg As String _ 
      ,sFieldnameValue As String _ 
      ,sFieldnamePK As String _ 
      ,sTablename As String 
      
    '----------------------------------------- CUSTOMIZE
   sFieldnameValue =  "PropName" 'String, Name of Short Text field
   sFieldnamePK =  "PropertyID"  'String, Name of Long Integer/Autonumber PK field
   sTablename =  "dm_Property"   'String, name of table
   '------------------------------------------
      
   'get value to test
   With Me.ActiveControl 
      If IsNull(.Value) Then Exit Sub 
      sValue = Trim(.Value) 
   End With 
   
   'get primary key for changed record
   '  -99 will be used if PK doesn't yet have a value
   nRecordID = Nz(Me(sFieldnamePK),-99) 
   
   'construct WHERE clause
   sWhere =  "(" & sFieldnameValue &  "= '" & sValue &  "')"
   
   'if not new record, add PK to WHERE clause
   If nRecordID <> -99 Then 
      sWhere = sWhere _ 
         &  " AND (" & sFieldnamePK &  " <> " & nRecordID &  ")"
   End If 
   
   'get PK of other record with this value
   '  -99 means the value wasn't found on other record
   nRecordID = Nz(DLookup( _ 
         sFieldnamePK _ 
         ,sTablename _ 
         ,sWhere),-99) 
         
   If nRecordID <> -99 Then 
      'value found on another record
      sMsg =  "'" & sValue &  "' already exists" _ 
         & vbCrLf &  "    OK = Move to record" _ 
         & vbCrLf &  "    Cancel = Stay here and fix the value"
      
      If MsgBox(sMsg _ 
         ,vbOKCancel _ 
         , "Duplicate Value. Move or Stay?") = vbOK _ 
      Then 
         'move to record
         With Me.RecordsetClone 
            .FindFirst sFieldnamePK &  "=" & nRecordID 
            If Not .NoMatch Then 
               Me.Undo 
               Cancel = True 
               Me.Bookmark = .Bookmark 
            Else
               'code to remove filter and look again -- YOU write
            End If 
         End With 'RecordsetClone
      Else 
         'cancel control update
         Cancel = True 
      End If 
   End If 
End Sub 
'*************** Code End *******************************************************

El código se generó con colores utilizando el complemento gratuito Color Code para Access.