Gru? TommyK

Private Sub dbcreat_Click()
 
Dim Db As Database
Dim dbFile As String
Dim tdfNew1 As TableDef
Dim tdfNew2 As TableDef
Dim tdfNew3 As TableDef
Dim idxNew As New Index
Dim relNew As Relation
 
On Error GoTo err_Handler
 
'Datenbank öffnen und Tabellen erstellen
dbFile = App.Path + "\db_musikcds.mdb"
Set Db = Workspaces(0).CreateDatabase(dbFile, dbLangGeneral)
 
Set tdfNew1 = Db.CreateTableDef("tbl_bands")
With tdfNew1
    .Fields.Append .CreateField("band_id", dbLong)
    .Fields(0).Attributes = dbAutoIncrField
    .Fields.Append .CreateField("band_name", dbText, 255)
    Set idxNew = .CreateIndex("band_PS")
    idxNew.Fields.Append idxNew.CreateField("band_id")
    idxNew.Primary = True
    .Indexes.Append idxNew
    Set idxNew = Nothing
    Set idxNew = .CreateIndex("band_NAME")
    idxNew.Fields.Append idxNew.CreateField("band_name")
    .Indexes.Append idxNew
    Set idxNew = Nothing
End With
Db.TableDefs.Append tdfNew1
 
Set tdfNew2 = Db.CreateTableDef("tbl_albums")
With tdfNew2
    .Fields.Append .CreateField("cd_id", dbLong)
    .Fields.Append .CreateField("band_id", dbLong)
    .Fields.Append .CreateField("num_tracks", dbByte)
    .Fields.Append .CreateField("album_title", dbText, 255)
    Set idxNew = .CreateIndex("cd_PS")
    idxNew.Fields.Append idxNew.CreateField("cd_id")
    idxNew.Primary = True
    .Indexes.Append idxNew
    Set idxNew = Nothing
    Set idxNew = .CreateIndex("band_FS")
    idxNew.Fields.Append idxNew.CreateField("band_id")
    idxNew.Primary = False
    .Indexes.Append idxNew
    Set idxNew = Nothing
End With
Db.TableDefs.Append tdfNew2
 
Set tdfNew3 = Db.CreateTableDef("tbl_tracks")
With tdfNew3
    .Fields.Append .CreateField("cd_id", dbLong)
    .Fields.Append .CreateField("track_nr", dbByte)
    .Fields.Append .CreateField("track_title", dbText, 255)
    .Fields(2).AllowZeroLength = True
    .Fields.Append .CreateField("lenght", dbLong)
    Set idxNew = .CreateIndex("cd_FS")
    idxNew.Fields.Append idxNew.CreateField("cd_id")
    idxNew.Primary = False
    .Indexes.Append idxNew
    Set idxNew = Nothing
End With
Db.TableDefs.Append tdfNew3
 
'Beziehung Band -> Album erstellen
Set relNew = Db.CreateRelation( _
    "band_ID", tdfNew1.Name, tdfNew2.Name, _
    dbRelationUpdateCascade + dbRelationDeleteCascade)
relNew.Fields.Append relNew.CreateField("band_id")
relNew.Fields!band_id.ForeignName = "band_id"
Db.Relations.Append relNew
Set relNew = Nothing
 
'Beziehung Album -> Tracks erstellen
Set relNew = Db.CreateRelation( _
    "cd_ID", tdfNew2.Name, tdfNew3.Name, _
    dbRelationUpdateCascade + dbRelationDeleteCascade)
relNew.Fields.Append relNew.CreateField("cd_id")
relNew.Fields!cd_id.ForeignName = "cd_id"
Db.Relations.Append relNew
Set relNew = Nothing
 
Db.Close
 
'Fehlermeldungen bei der Datenbankerstellung
 
err_Handler:
  Select Case Err.Number
    Case 3204
      MsgBox "Die Datenbank ist bereits vorhanden!", vbExclamation, "Fehler"
    Case 0
      MsgBox "Datenbank erfolgreich angelegt!", vbExclamation, "Erstellen" & _
        "erfolgreich"
    Case Else
      MsgBox "Es ist der Fehler:" & Str$(Err.Number) & vbCrLf & """" & _
        Err.Description & """ aufgetreten.", vbCritical, "Fehler"
  End Select
 
End Sub