TKSoft-Online

Sub NewCreateTable(strNewTabName As String, strNewFldName As String, _
            strNewFldTyp As String, _
            intNewFldSize As Integer, lngAttributes As Long, _
            Optional boolNewZeroL As Boolean = False, _
            Optional strNewDefaultV As String = "", _
            Optional boolNewReq As Boolean = False, _
            Optional strNewVRule As String = "", _
            Optional strNewVTxt As String = "")
'*******************************************
'Name:      NewCreateTable (Sub)
'Purpose:   Erstellt eine neue Tabelle in der aktuellen Datenbank
'Author:    Thomas Keßler
'Date:      Dezember 01, 2002, 10:00:15
'Inputs:    NewTabName = Name der neuen Tabelle,
'           NewFldName = Name des neuen Feldes
'           NewFldTyp = Typ des neuen Feldes, NewFldSize = Grösse des neuen Feldes,
'           NewZeroL=Null Zeichenfolge zulässig
'           NewDefaultV = Standardwert, NewReq = Eingabe erforderlich ?,
'           NewVRule = Gültigkeitsregel, NewVTxt = Gültigkeitsmeldung
'           VarAttributes=Eigenschaftseinstellungen
'           Attribute:
'           dbBoolean,dbByte,dbInteger,dbCurrency,dbSingle,dbDouble,dbDate,dbLong = 1
'           Autowert=17 (Feld muss aber vom Typ dbLong sein)
'           dbText,dbLongBinary,dbMemo = 2
'           Hyperlink=32770 (Feld muss aber vom Typ dbMemo sein)
'Output:
'*******************************************
On Error GoTo Err_NewTable

    Dim db As DAO.Database
    Dim tblNew As DAO.TableDef
    Dim Fld As DAO.Field

    '   Erstellen Tabelle und ein Feld
    Set db = CurrentDb
    Set tblNew = db.CreateTableDef(strNewTabName)
    Set Fld = tblNew.CreateField(strNewFldName, strNewFldTyp, intNewFldSize)

    '   Anfügen Feld an Auflistung
    tblNew.Fields.Append Fld
    
    '   Einstellen Feldeigenschaften
    Fld.AllowZeroLength = boolNewZeroL
    Fld.DefaultValue = strNewDefaultV
    Fld.Required = boolNewReq
    Fld.ValidationRule = strNewVRule
    Fld.ValidationText = strNewVTxt
    Fld.Attributes = lngAttributes
    
    
    '   Anfügen Tabelle an Auflistung
    db.TableDefs.Append tblNew

  Set db = Nothing
    
Err_NewTable_Exit:
    Exit Sub
Err_NewTable:
    Dim strErrString As String
    strErrString = "Error Information..." & vbCrLf
    strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
    strErrString = strErrString & "Description: " & Err.Description & vbCrLf
    MsgBox strErrString, vbCritical + vbOKOnly, "Error in Sub: NewCreateTable"
    Resume Err_NewTable_Exit
End Sub

Es muss bei der Erstellung einer Tabelle gleichzeitig ein Feld mit erstellt werden!