Sunday 24 June 2012

Ex13: VBA - Set field description using DAO

Assign a Description to a field 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 SetFieldDescription(tdf As DAO.TableDef, fld As DAO.Field, _
Optional ByVal strDescrip As String, Optional strErrMsg As String) _
As Boolean
    'Purpose:   Assign a Description to a field.
    'Arguments: tdf = the TableDef the field belongs to.
    '           fld = the field to document.
    '           strDescrip = The description text you want.
    '                        If blank, uses Caption or Name of field.
    '           strErrMsg  = string to append any error messages to.
    'Notes:     Description includes field size, validation,
    '               whether required or unique.
    
    If (fld.Attributes And dbAutoIncrField) > 0& Then
        strDescrip = strDescrip & " Automatically generated " & _
            "unique identifier for this record."
    Else
        'If no description supplied, use the field's Caption or Name.
        If Len(strDescrip) = 0& Then
            If HasProperty(fld, "Caption") Then
                If Len(fld.Properties("Caption")) > 0& Then
                    strDescrip = fld.Properties("Caption") & "."
                End If
            End If
            If Len(strDescrip) = 0& Then
                strDescrip = fld.Name & "."
            End If
        End If
        
        'Size of the field.
        'Ignore Date, Memo, Yes/No, Currency, Decimal, GUID,
        '   Hyperlink, OLE Object.
        Select Case fld.Type
        Case dbByte, dbInteger, dbLong
            strDescrip = strDescrip & " Whole number."
        Case dbSingle, dbDouble
            strDescrip = strDescrip & " Fractional number."
        Case dbText
            strDescrip = strDescrip & " " & fld.Size & "-char max."
        End Select
        
        'Required and/or Unique?
        'Check for single-field index, and Required property.
        Select Case IndexOnField(tdf, fld)
        Case intcIndexPrimary
            strDescrip = strDescrip & " Required. Unique."
        Case intcIndexUnique
            If fld.Required Then
                strDescrip = strDescrip & " Required. Unique."
            Else
                strDescrip = strDescrip & " Unique."
            End If
        Case Else
            If fld.Required Then
                strDescrip = strDescrip & " Required."
            End If
        End Select
        
        'Validation?
        If Len(fld.ValidationRule) > 0& Then
            If Len(fld.ValidationText) > 0& Then
                strDescrip = strDescrip & " " & fld.ValidationText
            Else
                strDescrip = strDescrip & " " & fld.ValidationRule
            End If
        End If
    End If
    
    If Len(strDescrip) > 0& Then
        strDescrip = Trim$(Left$(strDescrip, 255&))
        SetFieldDescription = SetPropertyDAO(fld, "Description", _
            dbText, strDescrip, strErrMsg)
    End If
End Function

No comments:

Post a Comment