Sunday, 24 June 2012

Ex1: VBA Create tables using DAO

Create two tables using DAO, illustrating the field types.
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 CreateTableDAO()
    'Purpose:   Create two tables using DAO.
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    
    'Initialize the Contractor table.
    Set db = CurrentDb()
    Set tdf = db.CreateTableDef("tblDaoContractor")
    
    'Specify the fields.
    With tdf
        'AutoNumber: Long with the attribute set.
        Set fld = .CreateField("ContractorID", dbLong)
        fld.Attributes = dbAutoIncrField + dbFixedField
        .Fields.Append fld
        
        'Text field: maximum 30 characters, and required.
        Set fld = .CreateField("Surname", dbText, 30)
        fld.Required = True
        .Fields.Append fld
        
        'Text field: maximum 20 characters.
        .Fields.Append .CreateField("FirstName", dbText, 20)
        
        'Yes/No field.
        .Fields.Append .CreateField("Inactive", dbBoolean)
        
        'Currency field.
        .Fields.Append .CreateField("HourlyFee", dbCurrency)
        
        'Number field.
        .Fields.Append .CreateField("PenaltyRate", dbDouble)
        
        'Date/Time field with validation rule.
        Set fld = .CreateField("BirthDate", dbDate)
        fld.ValidationRule = "Is Null Or <=Date()"
        fld.ValidationText = "Birth date cannot be future."
        .Fields.Append fld
        
        'Memo field.
        .Fields.Append .CreateField("Notes", dbMemo)
        
        'Hyperlink field: memo with the attribute set.
        Set fld = .CreateField("Web", dbMemo)
        fld.Attributes = dbHyperlinkField + dbVariableField
        .Fields.Append fld
    End With
    
    'Save the Contractor table.
    db.TableDefs.Append tdf
    Set fld = Nothing
    Set tdf = Nothing
    Debug.Print "tblDaoContractor created."
    
    'Initialize the Booking table
    Set tdf = db.CreateTableDef("tblDaoBooking")
    With tdf
        'Autonumber
        Set fld = .CreateField("BookingID", dbLong)
        fld.Attributes = dbAutoIncrField + dbFixedField
        .Fields.Append fld
        
        'BookingDate
        .Fields.Append .CreateField("BookingDate", dbDate)
        
        'ContractorID
        .Fields.Append .CreateField("ContractorID", dbLong)
        
        'BookingFee
        .Fields.Append .CreateField("BookingFee", dbCurrency)
        
        'BookingNote: Required.
        Set fld = .CreateField("BookingNote", dbText, 255)
        fld.Required = True
        .Fields.Append fld
    End With
    
    'Save the Booking table.
    db.TableDefs.Append tdf
    Set fld = Nothing
    Set tdf = Nothing
    Debug.Print "tblDaoBooking created."
    
    'Clean up
    Application.RefreshDatabaseWindow   'Show the changes
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Function

No comments:

Post a Comment