The DefaultClear Function

Public 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.

home