Разработка модели базы данных

' Created		02.02.2006
' Modified		03.02.2006
' Project		Kontingent 
' Model		Students	
' Company		AGTU 
' Author		Groshev	
' Version		2006.1
' Database		Access 2000 
'=======================================================
'=== MS Access 2000 database creation method
'===
'=== 1. Create a new database in the MS Access 2000
'=== 2. Create a new module
'=== 3. Copy the CASE Studio 2 output SQL script into the new MS Access 2000 module
'=== 4. Select from main menu "Tools" item "References..." and check 
'===     the "Microsoft DAO 3.6 Object Library."
'=== 5. Place your mouse cursor somewhere in the main procedure Main()
'=== 6. Run the module code (Click the "Run Sub/UserForm" button or press F5)
'=======================================================
Public dbs As DAO.Database
Public tdf As DAO.TableDef
Public idx As DAO.Index
Public rel As DAO.Relation
Sub Main()
Set dbs = CurrentDb()
On Error GoTo ErrorHandler
	Call CreateTables
	Call CreatePrimaryKeys
	Call CreateIndexes
	Call CreateAlterKeys
	Call CreateRelations
	Call CreateQueries
	MsgBox "Script successfully processed.", vbInformation
	Exit Sub
ErrorHandler:
	Select Case Err.Number
		Case 3010
			MsgBox "Table " & tdf.Name & " allready exist!", vbInformation
			Err.Clear
      Case 3284
         MsgBox "Index " & idx.Name & " for table " & tdf.Name & " allready exist!", vbInformation
         Err.Clear
		Case Else
			MsgBox Err.Description, vbCritical
	End Select
End Sub
' Create tables
'===============
Sub CreateTables()
Call CreateTable1 'Student
Call CreateTable2 'Ocenki
Call CreateTable3 'Predmet
Call CreateTable4 'FCLT
Call CreateTable5 'SPECT
End Sub
'=== Create table Student ======
Sub CreateTable1()
Set tdf = dbs.CreateTableDef( "Student" )
Call AddFieldToTable("Nz", dbText, 7, 0, "", "", "", TRUE )
Call AddFieldToTable("Fio", dbText, 45, 0, "", "", "", FALSE )
Call AddFieldToTable("date_p", dbDate, 0, 0, "", "", "", FALSE )
Call AddFieldToTable("n_fclt", dbSingle, 0, 0, "", "", "", TRUE )
Call AddFieldToTable("n_spect", dbText, 9, 0, "", "", "", TRUE )
Call AddFieldToTable("kurs", dbSingle, 0, 0, "", "", "", FALSE )
Call AddFieldToTable("n_grup", dbText, 10, 0, "", "", "", FALSE )
Call AddFieldToTable("n_pasp", dbText, 10, 0, "", "", "", FALSE )
dbs.TableDefs.Append tdf
End Sub
'=== Create table Ocenki ======
Sub CreateTable2()
Set tdf = dbs.CreateTableDef( "Ocenki" )
Call AddFieldToTable("semestr", dbSingle, 0, 0, "", "", "", FALSE )
Call AddFieldToTable("n_predm", dbSingle, 0, 0, "", "", "", TRUE )
Call AddFieldToTable("ball", dbText, 1, 0, "", "", "", FALSE )
Call AddFieldToTable("data_b", dbDate, 0, 0, "", "", "", FALSE )
Call AddFieldToTable("Prepod", dbText, 45, 0, "", "", "", FALSE )
Call AddFieldToTable("Nz", dbText, 7, 0, "", "", "", TRUE )
dbs.TableDefs.Append tdf
End Sub
'=== Create table Predmet ======
Sub CreateTable3()
Set tdf = dbs.CreateTableDef( "Predmet" )
Call AddFieldToTable("n_predm", dbSingle, 0, 0, "", "", "", TRUE )
Call AddFieldToTable("name_p", dbText, 120, 0, "", "", "", FALSE )
dbs.TableDefs.Append tdf
End Sub
'=== Create table FCLT ======
Sub CreateTable4()
Set tdf = dbs.CreateTableDef( "FCLT" )
Call AddFieldToTable("n_fclt", dbSingle, 0, 0, "", "", "", TRUE )
Call AddFieldToTable("name_f", dbText, 120, 0, "", "", "", FALSE )
dbs.TableDefs.Append tdf
End Sub
'=== Create table SPECT ======
Sub CreateTable5()
Set tdf = dbs.CreateTableDef( "SPECT" )
Call AddFieldToTable("n_spect", dbText, 9, 0, "", "", "", TRUE )
Call AddFieldToTable("name_S", dbText, 120, 0, "", "", "", FALSE )
dbs.TableDefs.Append tdf
End Sub
' Create primary keys
'=====================
Sub CreatePrimaryKeys()
'=== Create primary key for table Student ======
Set tdf = dbs.TableDefs( "Student" )
Set idx = tdf.CreateIndex( "pk_Student" )
idx.Primary = True
idx.Unique  = True
idx.IgnoreNulls = False
Call AddFieldToIndex( "Nz", False )
tdf.Indexes.Append idx
'=== Create primary key for table Predmet ======
Set tdf = dbs.TableDefs( "Predmet" )
Set idx = tdf.CreateIndex( "pk_Predmet" )
idx.Primary = True
idx.Unique  = True
idx.IgnoreNulls = False
Call AddFieldToIndex( "n_predm", False )
tdf.Indexes.Append idx
'=== Create primary key for table FCLT ======
Set tdf = dbs.TableDefs( "FCLT" )
Set idx = tdf.CreateIndex( "pk_FCLT" )
idx.Primary = True
idx.Unique  = True
idx.IgnoreNulls = False
Call AddFieldToIndex( "n_fclt", False )
tdf.Indexes.Append idx
'=== Create primary key for table SPECT ======
Set tdf = dbs.TableDefs( "SPECT" )
Set idx = tdf.CreateIndex( "pk_SPECT" )
idx.Primary = True
idx.Unique  = True
idx.IgnoreNulls = False
Call AddFieldToIndex( "n_spect", False )
tdf.Indexes.Append idx
End Sub
' Create indexes
'================
Sub CreateIndexes()
End Sub
' Create alter keys (unique indexes in MS ACCESS)
'================================================
Sub CreateAlterKeys()
End Sub
' Create relations
'==================
Sub CreateRelations()
'=== Create relations between parent table Student and child table Ocenki ======
Set rel = dbs.CreateRelation("Student_Ocenki")
rel.Table			= "Student"
rel.ForeignTable	= "Ocenki"
rel.Attributes	= dbRelationUpdateCascade+dbRelationDeleteCascade
Call AddFieldToRelation("Nz", "Nz")
dbs.Relations.Append rel
'=== Create relations between parent table Predmet and child table Ocenki ======
Set rel = dbs.CreateRelation("Predmet_Ocenki")
rel.Table			= "Predmet"
rel.ForeignTable	= "Ocenki"
rel.Attributes	= dbRelationUpdateCascade+dbRelationDeleteCascade
Call AddFieldToRelation("n_predm", "n_predm")
dbs.Relations.Append rel
'=== Create relations between parent table FCLT and child table Student ======
Set rel = dbs.CreateRelation("FCLT_Student")
rel.Table			= "FCLT"
rel.ForeignTable	= "Student"
rel.Attributes	= dbRelationUpdateCascade+dbRelationDeleteCascade
Call AddFieldToRelation("n_fclt", "n_fclt")
dbs.Relations.Append rel
'=== Create relations between parent table SPECT and child table Student ======
Set rel = dbs.CreateRelation("SPECT_Student")
rel.Table			= "SPECT"
rel.ForeignTable	= "Student"
rel.Attributes	= dbRelationUpdateCascade+dbRelationDeleteCascade
Call AddFieldToRelation("n_spect", "n_spect")
dbs.Relations.Append rel
End Sub
' Create queries
'================
Sub CreateQueries()
Dim qdf As QueryDef
End Sub
' Add fields to table
'=====================
Sub AddFieldToTable(FieldName As String, DataType As String, SizeCol As Integer, 
                               Attributes As Long, DefaultValue As Variant, ValText As String, 
                               ValRule As String, NotN As Boolean)
Dim fld As DAO.Field
Set fld = tdf.CreateField( FieldName, DataType )
If SizeCol 		<> 0 Then fld.Size	   	= SizeCol
If Attributes	<> 0 Then fld.Attributes	= Attributes
fld.Required 			= NotN
fld.DefaultValue 		= DefaultValue
fld.ValidationRule 	= ValRule
fld.ValidationText 	= ValText
tdf.Fields.Append fld
End Sub
' Add properties to table
'=========================
Sub AddPropertyToTable( PropertyName As String, Value As Variant, DataType As String)
Dim prp As DAO.Property
Set prp = tdf.CreateProperty(PropertyName, DataType, Value)
tdf.Properties.Append prp
End Sub
' Add properties to field
'=========================
Sub AddPropertyToField(FieldName As String, PropertyName As String, Value As Variant, 
                                    DataType As String)
Dim prp As DAO.Property
Dim fld As DAO.Field
Set fld = tdf.Fields( FieldName )
Set prp = fld.CreateProperty(PropertyName, DataType, Value)
fld.Properties.Append prp
End Sub
' Add fields to index
'=====================
Sub AddFieldToIndex( FieldName As String, Descending As Boolean )
Dim fld As DAO.Field
Set fld = idx.CreateField( FieldName )
If Descending = True Then fld.Attributes = dbDescending
idx.Fields.Append fld
End Sub
' Add fields to relation
'========================
Sub AddFieldToRelation( PKField As String, FKField As String )
Dim fld As DAO.Field
Set fld = rel.CreateField( PKField )
fld.ForeignName = FKField
rel.Fields.Append fld
End Sub