The DefaultClear FunctionPublic Function DefaultClear( _ strDefault As String, _ strRecordSource As String, _ strID As String, _ lngID As Long _ ) As Boolean 'Copyright (c) Brendan Reynolds/Timarco Ltd, 1999. 'All rights reserved. 'e-mail [email protected] 'This function sets the yes/no field specified in the 'argument strDefault, in the table or query specified 'in the argument strRecordSource, to False in all 'records where the value of that field is True and the 'value of the field specified in the argument strID is 'not equal to the value specified in the argument lngID. 'In short, it is intended to ensure that only one record 'in the recordsource has a value of True in the field 'specified in the argument strDefault. Note that this 'function is designed to work with tables that have an 'autonumber primary key. 'This function uses DAO code, and requires a reference 'to the DAO object library, which is not set by default 'in Access 2000. 'Arguments 'strDefault: The name of the yes/no field to be set to 'False. 'strRecordSource: The name of the table containing the 'field specified in the argument strDefault, or of a 'query including that field. 'strID: The name of the autonumber primary key field in 'the specified table. 'lngID: The value of the field specified in the argument 'strID in the current record. 'Return Values 'Returns True if any matching records were found, 'otherwise returns False. 'Use (from the After Update event of a form) 'If Me!chkDefault = True Then ' blnDefCleared = DefaultClear( _ ' "SomeYesNoField", _ ' "SomeTableOrQuery", _ ' "SomeAutoNumberPrimaryKeyField", _ ' Me!NameOfPrimaryKeyFieldOrControl _ ' ) 'End If On Error GoTo Err_Routine Dim lngErrNum As Long Dim db As DAO.Database Dim rst As DAO.Recordset DefaultClear = False Set db = CurrentDb Set rst = db.OpenRecordset("SELECT " & strDefault _ & " FROM " & strRecordSource _ & " WHERE " & strDefault & " = True" _ & " AND " & strID & " <> " & lngID) With rst If .RecordCount > 0 Then DefaultClear = True End If Do Until .EOF .Edit .Fields(strDefault) = False .Update .MoveNext Loop .Close End With Set rst = Nothing db.Close Set db = Nothing Exit_Routine: On Error Resume Next rst.Close Set rst = Nothing db.Close Set db = Nothing Exit Function Err_Routine: lngErrNum = Err.Number Select Case Err ' Case Else Err.Raise lngErrNum Resume Exit_Routine End Select End Function Download this function in plain text format, ready for import into your own Microsoft Access 97 or Microsoft Access 2000 application, here. |