Sunday, December 29, 2024

Breaking News

Tuesday, June 26, 2012

Ex4: VBA - Create a table using ADOX

Create a table with various field types using ADOX in VBA

Function CreateTableAdox()
'Purpose: Create a table with various field types, using ADOX.
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table

Set cat.ActiveConnection = CurrentProject.Connection
'Initialize the Contractor table.
Set tbl = New ADOX.Table
tbl.Name = "tblAdoxContractor"

'Append the columns.
With tbl.Columns
.Append "ContractorID", adInteger 'Number (Long Integer)
.Append "Surname", adVarWChar, 30 'Text (30 max)
.Append "FirstName", adVarWChar, 20 'Text (20 max)
.Append "Inactive", adBoolean 'Yes/No
.Append "HourlyFee", adCurrency 'Currency
.Append "PenaltyRate", adDouble 'Number (Double)
.Append "BirthDate", adDate 'Date/Time
.Append "Notes", adLongVarWChar 'Memo
.Append "Web", adLongVarWChar 'Memo (for hyperlink)

'Set the field properties.
'AutoNumber
With !ContractorID
Set .ParentCatalog = cat

.Properties("Autoincrement") = True 'AutoNumber.
.Properties("Description") = "Automatically " & _
"generated unique identifier for this record."
End With

'Required field.
With !Surname
Set .ParentCatalog = cat
.Properties("Nullable") = False 'Required.
.Properties("Jet OLEDB:Allow Zero Length") = False
End With

'Set a validation rule.
With !BirthDate
Set .ParentCatalog = cat
.Properties("Jet OLEDB:Column Validation Rule") = _
"Is Null Or <=Date()"
.Properties("Jet OLEDB:Column Validation Text") = _
"Birth date cannot be future."
End With

'Hyperlink field.
With !Web
Set .ParentCatalog = cat
.Properties("Jet OLEDB:Hyperlink") = True 'Hyperlink.
End With
End With

'Save the new table by appending to catalog.
cat.Tables.Append tbl
Debug.Print "tblAdoxContractor created."
Set tbl = Nothing

'Initialize the Booking table
Set tbl = New ADOX.Table
tbl.Name = "tblAdoxBooking"

'Append the columns.
With tbl.Columns
.Append "BookingID", adInteger
.Append "BookingDate", adDate
.Append "ContractorID", adInteger
.Append "BookingFee", adCurrency
.Append "BookingNote", adWChar, 255

'Set the field properties.
With !BookingID 'AutoNumber.
.ParentCatalog = cat
.Properties("Autoincrement") = True
End With
With !BookingNote 'Required.
.ParentCatalog = cat
.Properties("Nullable") = False
.Properties("Jet OLEDB:Allow Zero Length") = False
End With
End With

'Save the new table by appending to catalog.
cat.Tables.Append tbl
Debug.Print "tblAdoxBooking created."

'Clean up
Set tbl = Nothing
Set cat = Nothing
End Function

No comments:

Post a Comment

Designed By Published.. Blogger Templates