On 28 Jan 2005 07:03:48 -0800,
do*****@hotmail.com (doomx) wrote:
I'm using SQL scripts to create and alter tables in my DB
I want to know if it's possible to fill the description(like in the
Create table UI) using these scripts.
EX:
CREATE TABLE(
Pk_myPrimaryKey INTEGER CONSTRAINT pk PRIMARY KEY DESCRIPTION 'This
is the primary key of the table',
Field1 TEXT(50)
)
Thx
DoOmX
Not with SQL statements, but you can with DAO (set a DAO reference in
Access 2K+). These are routine I use to check and correct application
table stuctures (there's another one to capture finished table
stuctures, but you can figure that out) as defined in the
"tTableLibraryFields" table (partially defined below)
Field descriptions in access tables can be pissy becuse they're also
used on forms as default user prompts.
I know this is more than what you asked for, but use anything you find
value in, or ignor the whole thing.
Tom
Public Sub CheckTableDc(Structure As Byte, Name As String)
' check for existance and correctness of user named table structure
Dim i As Integer ' array index
Dim DB As Database ' database object
Dim Rs As Recordset ' fields record set
Dim TD As TableDef ' table definition object
Dim FD As Field ' field definition object
Dim Pd As Property ' property definition object
Dim Ix As Index ' index definition object
Dim Found As Boolean ' table found flag
Dim Delete As Boolean ' delete table flag
Dim Verify As Boolean ' verify flag
Dim Sql As String ' sql
'On Error GoTo ErrorRouter ' on error, goto error
routine
Set DB = CurrentDb ' get current db reference
Set TD = DB.CreateTableDef(Name) ' create table
Sql = "SELECT tTableLibraryFields.Name, tTableLibraryFields.Size,
tTableLibraryFields.Type, tTableLibraryFields.Caption,
tTableLibraryFields.DefaultValue, tTableLibraryFields.Description,
tTableLibraryFields.Index, tTableLibraryFields.Attributes " & _
"FROM tTableLibraryFields " & _
"WHERE (((tTableLibraryFields.TableID) = " & Structure & ")) " &
_
"ORDER BY tTableLibraryFields.Ordinal;"
Set Rs = DB.OpenRecordset(Sql) ' open record set
For Each TD In DB.TableDefs ' loop through all tables in
db
If TD.Name = Name Then ' if table found
Found = True ' set found flag
Exit For ' break loop
End If ' if table found
Next TD ' next table
If Found = True Then ' if table found, TD =
tabledef
GoSub VerifyTable ' verify table
If Delete = True Then GoSub CreateTable ' if table did NOT verify,
it was deleted, so create new one
Else ' if table NOT found
GoSub CreateTable ' create table
End If ' if table found, TD =
tabledef
Rs.Close ' close recordset
DB.Close ' close database
Set DB = Nothing ' free resources
Set Rs = Nothing ' free resources
Set TD = Nothing ' free resources
Set FD = Nothing ' free resources
Set Pd = Nothing ' free resources
Set Ix = Nothing ' free resources
Exit Sub ' all done
CreateTable: ' table wasn't found, so
build it
Set TD = DB.CreateTableDef(Name) ' create table definition
Rs.MoveFirst ' move to first record
Do Until Rs.EOF ' loop through all fields
for table
GoSub CreateField ' create field
Rs.MoveNext ' next field
Loop ' create next field
DB.TableDefs.Append TD ' append all completed
communication table fields
TD.Fields.Refresh ' refresh fields collection
TD.Indexes.Refresh ' refresh indexes collection
Set TD = DB.TableDefs(Name) ' get tabledef for table
For Each FD In TD.Fields ' loop through fields
Rs.MoveFirst ' move to first record
Do Until Rs.EOF ' loop through all fields
for table
If FD.Name = Rs!Name Then ' if field found, set
description
SetFieldProperty FD, "Description", dbText, Rs!Description
SetFieldProperty FD, "Caption", dbText, Rs!Caption
Exit Do ' break loop
End If ' if field found
Rs.MoveNext ' next field
Loop ' create next field
Next FD ' next field
Return ' return to caller
CreateField:
If Rs!Type = dbText Then ' if creating a text field
Set FD = TD.CreateField(Rs!Name, Rs!Type, Rs!Size) ' create field
with name, storage type, and size
FD.AllowZeroLength = True ' set field ZeroLength
string
ElseIf Rs!Type = dbMemo Then ' if creating a memo field
Set FD = TD.CreateField(Rs!Name, Rs!Type) ' create field with name
and storage type
FD.AllowZeroLength = True ' set field ZeroLength
string
Else ' if NOT creating a text
field
Set FD = TD.CreateField(Rs!Name, Rs!Type) ' create field with name
and storage type
End If ' if creating a text field
If Rs!Attributes <> 0 Then ' if user suFSlied
attribute(s)
FD.Attributes = Rs!Attributes ' set field attributes
End If ' if user suFSlied
attribute(s)
If Len(Rs!DefaultValue) <> 0 Then FD.DefaultValue = Rs!DefaultValue
TD.Fields.Append FD ' append field to fields
collection
If Rs!Index <> ifNo Then ' if field has an index
If Rs!Index = ifPrimary Then ' if primary index
Set Ix = TD.CreateIndex("PrimaryKey") ' create index named
"PrimaryKey"
Set FD = Ix.CreateField(Rs!Name) ' for field
Ix.Primary = True ' set if index is primary
ElseIf Rs!Index = ifUnique Then ' if unique index
Set Ix = TD.CreateIndex(Rs!Name) ' create index named same as
field
Set FD = Ix.CreateField(Rs!Name) ' for field
Ix.Unique = True ' set if index is unique
ElseIf Rs!Index = ifUniqNo Then ' if NOT unique index
Set Ix = TD.CreateIndex(Rs!Name) ' create index named same as
field
Set FD = Ix.CreateField(Rs!Name) ' for field
Ix.Unique = False ' set if index is unique
End If ' if primary index
Ix.Fields.Append FD ' append field to fields
collection
TD.Indexes.Append Ix ' append index to indexes
collection
End If ' if field has an index
Return ' return to caller
VerifyTable: ' table was found, so verify
it
Set TD = DB.TableDefs(Name) ' get tabledef for table
Rs.MoveFirst ' move to first record
For Each FD In TD.Fields ' loop through fields
Verify = False ' default verify flag
GoSub VerifyField ' verify field
If Verify = False Then ' if field does NOT match
field description
Delete = Delete
DB.TableDefs.Delete Name ' delete table
Delete = True ' set table deleted flag
Return ' break loop, return to
caller
End If ' if database does NOT match
field description
Next FD ' next field
For Each Ix In TD.Indexes ' loop through indexes
Verify = False ' default verify flag
GoSub VerifyIndex ' verify index
If Verify = False Then ' if index does NOT match
field description
Delete = Delete
DB.TableDefs.Delete Name ' delete table
Delete = True ' set table deleted flag
Return ' break loop, return to
caller
End If ' if database does NOT match
field description
Next Ix ' next index
Return ' return to caller
VerifyField:
Rs.MoveFirst ' move to first record
Do Until Rs.EOF ' loop through all fields
for table
If FD.Name = Rs!Name Then ' if field found, verify
If FD.Type <> Rs!Type Then Return ' if types don't match,
return
If FD.Type = dbText Then ' if Text type, check size
If FD.Size <> Rs!Size Then Return ' if sizes don't match,
return
If FD.AllowZeroLength <> True Then Return
ElseIf FD.Type = dbMemo Then ' if Memo type, check size
If FD.AllowZeroLength <> True Then Return
End If ' if Text type
If (FD.Attributes And Rs!Attributes) <> Rs!Attributes Then Return
If FD.DefaultValue <> Rs!DefaultValue Then Return
Verify = True ' signal caller that request
succeeded
Exit Do ' exit loop
End If ' if found description
Rs.MoveNext ' next field
Loop ' verify next field
Return ' return to caller
VerifyIndex:
Rs.MoveFirst ' move to first record
Do Until Rs.EOF ' loop through all fields
for table
If Ix.Fields = "+" & Rs!Name Then ' if field found
Select Case Rs!Index ' get field description
index code
Case ifNo ' if no index, this field is
not defined as a index, but no harm done
Case ifPrimary ' if primary index
If Ix.Name <> "PrimaryKey" Then Return
If Ix.Primary = False Then Return '
If Ix.Unique = False Then Return '
Case ifUnique ' if unique index
If Ix.Name <> Rs!Name Then Return '
If Ix.Primary = True Then Return '
If Ix.Unique = False Then Return '
Case ifUniqNo ' if non-unique index
If Ix.Name <> Rs!Name Then Return '
If Ix.Primary = True Then Return '
If Ix.Unique = True Then Return '
Case Else ' if coding boo-boo
Return
End Select ' get field description
index code
Verify = True ' signal caller that request
succeeded
Exit Do ' exit loop
End If ' if field found
Rs.MoveNext ' next field
Loop ' verify next field
Return ' return to caller
ErrorRouter: ' error router
ERR.Raise ERR.Number, ERR.Source, ERR.Description ' let caller handle
error reporting
End Sub
'
************************************************** ****************************************
' Disk-Comm Private Routines
'
************************************************** ****************************************
Private Sub SetFieldProperty(FD As Field, PropName As String, PropType
As Integer, PropValue As Variant)
' Create Property object, setting its Name, Type, and Value properties
Const ERR_PROPERTY_NONEXISTENT = 3270 ' property not set,
therefore does not exit
Dim MyProperty As Property ' property object
On Error Resume Next ' function handles errors
FD.Properties(PropName) = PropValue ' force the property to be
set, this creates an error if the property does not exist
If ERR <> 0 Then ' if error occurred when
property value was set
If ERR = 3270 Then ' if the error is "Property
does not exist"
On Error GoTo 0 ' reset error
On Error Resume Next ' function handles errors
(again because of reset)
Set MyProperty = FD.CreateProperty(PropName, PropType, PropValue)
FD.Properties.Append MyProperty ' Append this property
On Error GoTo 0 ' reset error
End If ' if property does not exist
End If ' if error occurred when
property value was set
End Sub
