Private Function CreateCDB(Byval sDBPfadName As String) As Byte
       Dim DB As DataBase
       Dim Tbl As TableDef
       Dim Fld As Field
       Dim ctl As Control
 
       If Dir(sDBPfadName) <> "" Then Kill sDBPfadName
 
       Set DB = DBEngine.CreateDataBase(sDBPfadName,dbLanggeneral,dbEncrypt)
 
       Set Tbl = DB.CreateTableDef("Komponisten") ' Achtung: Nicht Tabelle 
       ' nennen!
       With Tbl
            For Each ctl In Form1.Controls
                   If ctl.Tag <> "" Then
                         Select Case ctl.Tag
                                Case "ID" : .Fields.Append .CreateField( _
                                  ctl.Tag,dbLong)
                                Case "Vorname": .Fields.Append .CreateField( _
                                ctl.Tag,dbText,50)
                                Case "Nachname": .Fields.Append .CreateField( _
                                ctl.Tag,dbText,50)
                                Case "geb": .Fields.Append .CreateField( _
                                ctl.Tag,dbDate) 
                                Case "gest": .Fields.Append .CreateField( _
                                ctl.Tag,dbDate) 
                                Case "Land": .Fields.Append .CreateField( _
                                ctl.Tag,dbText,75)
                                Case "Pfad": .Fields.Append .CreateField( _
                                ctl.Tag,dbText,255)
                         End Select
                   End If
            Next
            .Fields("ID").Attributes = dbAutoIncrField
        End With 
        For Each Fld In Tbl.Fields
              Fld.AllowZeroLenght = True
        Next  
        Db.Tabledefs.Append Tbl
        DB.Close
 
        CreateCDB = 1
Enf Function 
 
Private Sub ReadDS(Rs As Recordset)
        Dim ctl As Control   
 
        On Error Resume Next
        For Each ctl In Form1.Controls
             If ctl.Tag <> "" Then
                   ctl.Text = Rs.Fields(ctl.Text).Value
             End IF
         Next
End Sub
 
Private Sub SaveDS(Rs As Recordset, Optional Byval nAddNew As Byte = 0)
         Dim ctl As Control
 
         If nAddnew = 1 Then
                Rs.AddNew
         Else
                Rs.Edit
         End If
 
          For Each ctl In Form1.Controls
               If ctl.Tag <> "" Then
                      Rs.Fields(ctl.Tag).Value = ctl.Text
               End If
          Next
          Rs.Update
End Sub