Сгенерированная Case Studio программа создания таблиц базы данных для СУБД Access
' 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
