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