Sunday 24 June 2012

Ex11: VBA - Set default properties using DAO

Properties you always want set by default using DAO in VBA

Option Compare Database
Option Explicit

'Constants for examining how a field is indexed.
Private Const intcIndexNone As Integer = 0
Private Const intcIndexGeneral As Integer = 1
Private Const intcIndexUnique As Integer = 3
Private Const intcIndexPrimary As Integer = 7


Function StandardProperties(strTableName As String)
    'Purpose:   Properties you always want set by default:
    '           TableDef:        Subdatasheets off.
    '           Numeric fields:  Remove Default Value.
    '           Currency fields: Format as currency.
    '           Yes/No fields:   Display as check box. Default to No.
    '           Text/memo/hyperlink: AllowZeroLength off,
    '                                UnicodeCompression on.
    '           All fields:      Add a caption if mixed case.
    'Argument:  Name of the table.
    'Note:      Requires: SetPropertyDAO()
    Dim db As DAO.Database      'Current database.
    Dim tdf As DAO.TableDef     'Table nominated in argument.
    Dim fld As DAO.Field        'Each field.
    Dim strCaption As String    'Field caption.
    Dim strErrMsg As String     'Responses and error messages.
    
    'Initalize.
    Set db = CurrentDb()
    Set tdf = db.TableDefs(strTableName)
    
    'Set the table's SubdatasheetName.
    Call SetPropertyDAO(tdf, "SubdatasheetName", dbText, "[None]", _
        strErrMsg)
    
    For Each fld In tdf.Fields
        'Handle the defaults for the different field types.
        Select Case fld.Type
        Case dbText, dbMemo 'Includes hyperlinks.
            fld.AllowZeroLength = False
            Call SetPropertyDAO(fld, "UnicodeCompression", dbBoolean, _
                True, strErrMsg)
        Case dbCurrency
            fld.DefaultValue = 0
            Call SetPropertyDAO(fld, "Format", dbText, "Currency", _
                strErrMsg)
        Case dbLong, dbInteger, dbByte, dbDouble, dbSingle, dbDecimal
            fld.DefaultValue = vbNullString
        Case dbBoolean
            Call SetPropertyDAO(fld, "DisplayControl", dbInteger, _
                CInt(acCheckBox))
        End Select
        
        'Set a caption if needed.
        strCaption = ConvertMixedCase(fld.Name)
        If strCaption <> fld.Name Then
            Call SetPropertyDAO(fld, "Caption", dbText, strCaption)
        End If
        
        'Set the field's Description.
        Call SetFieldDescription(tdf, fld, , strErrMsg)
    Next
    
    'Clean up.
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
    If Len(strErrMsg) > 0 Then
        Debug.Print strErrMsg
    Else
        Debug.Print "Properties set for table " & strTableName
    End If
End Function

No comments:

Post a Comment