TKSoft-Online

Sub NewCreateField(strTabName 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:      NewCreateField (Sub)
'Purpose:   Erstellt ein neues Feld in der angegebenen Tabelle in der aktuellen Datenbank
'Author:    Thomas Keßler
'Date:      Januar 09, 2003, 14:05:15
'Inputs:    TabName = 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_NewField

    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Dim fld As DAO.Field

    Set db = CurrentDb
    Set tbl = db.TableDefs(strTabName)
    Set fld = tbl.CreateField(strNewFldName, strNewFldTyp, intNewFldSize)
    
    fld.Attributes = lngAttributes
    
    '   Anfügen Feld an Auflistung
    tbl.Fields.Append fld
    
    '   Einstellen Feldeigenschaften
    fld.AllowZeroLength = boolNewZeroL
    fld.DefaultValue = strNewDefaultV
    fld.Required = boolNewReq
    fld.ValidationRule = strNewVRule
    fld.ValidationText = strNewVTxt
    
    Set db = Nothing
    
Err_NewField_Exit:
    Exit Sub
Err_NewField:
    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: NewCreateField"
    Resume Err_NewField_Exit
End Sub