VBA, MS Access MS Access в примерах

Добавление поля в таблицу (DAO)

Private Sub AddNewTextField(sTName$, sFiedName$)
'Добавление (текстового) поля ...
Dim dbs  As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field

On Error GoTo AddNewFieldErr
    Set dbs = CurrentDb
    Set tbl = dbs.TableDefs(sTName)
    Set fld = tbl.CreateField(sFiedName)
    'Определение свойств поля
    With fld
        .Type = dbText
    End With
    'Добавление
    tbl.Fields.Append fld

AddNewFieldBye:
    On Error Resume Next
    Set dbs = Nothing
    Set fld = Nothing
    Set tbl = Nothing
    Err.Clear
    Exit Sub

AddNewFieldErr:
    If Err.Number <> 3191 Then 'поле уже есть
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
            "in procedure AddNewField of Module mod00Test", vbCritical, "Error!"
    End If
    Resume AddNewFieldBye
End Sub


Ещё:

Public Sub AddNewField(sDBPath$)
'Создание поля ...
Dim dbe As DAO.DBEngine
Dim db  As DAO.Database
Dim fld As DAO.Field
Dim tbl As DAO.TableDef

On Error GoTo AddNewFieldErr
    Set dbe = CreateObject("DAO.DBEngine.120")
    Set db = dbe.OpenDatabase(sDBPath) 'CurrentDb
    Set tbl = db.TableDefs("Угоди")
    Set fld = tbl.CreateField("Назва_Файла")
    'Определение свойств поля
    With fld
        .Type = dbText
    End With
    'Добавление
    tbl.Fields.Append fld

AddNewFieldBye:
    Set dbe = Nothing
    Set db = Nothing
    Set fld = Nothing
    Set tbl = Nothing
    Exit Sub

AddNewFieldErr:
    If Err.Number <> 3191 Then 'поле уже есть
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
            "in procedure AddNewField of Module mod00Test", vbCritical, "Error!"
    End If
    Resume AddNewFieldBye
End Sub


Ещё:

Private Sub AddNewField()
Dim fld As DAO.Field
Dim tbl As DAO.TableDef
Dim db As DAO.Database

On Error GoTo AddNewFieldErr
    Set db = CurrentDb
    Set tbl = db.TableDefs("tblExample")
    Set fld = tbl.CreateField("exNewFieldINT")
    'Определение свойств поля
    With fld
        .Type = dbInteger
        .DefaultValue = 0
    End With
    'Добавление
    tbl.Fields.Append fld

AddNewFieldBye:
    Exit Sub

AddNewFieldErr:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure AddNewField of Module mod00Test", vbCritical, "Error!"
    Resume AddNewFieldBye
End Sub


Ещё:


ALTER TABLE Employees ADD COLUMN Notes TEXT(25)

Назад ToTop
L.E. 07.10.2022
Рейтинг@Mail.ru