使用VBA将字段添加到MS Access Table

Question

I need to add a calculated field to an existing table. I am aware of two ways to do this and I'm wondering if anyone has any input on which is best and how to make them work:

1. Using TableDef.CreateField, then TableDef.Fields.Append
2. Using a DDL Alter Table ADD COLUMN statement

I tried using the first method, but I keep getting a 3211 error because Access could not lock the table. I don't have the table open. However, I am calling CreateField from a form that has accessed which fields currently exist in the table.

Here's the code for calling CreateField:

`
Public Sub AddFieldToTable(strTable As String, strField As String, nFieldType As     Integer)

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

    On Error GoTo ErrorHandler

    Set db = CurrentDb
    Set tdf = db.TableDefs(strTable)
    Set fld = tdf.CreateField(strField, nFieldType)
    tdf.Fields.Append fld

    MsgBox "The field named [" & strField & "] has been added to table [" & strTable & "]."

    Set tdf = Nothing
    Set db = Nothing

    Exit Sub

    ErrorHandler:
        MsgBox "An error has occurred. Number: " & Err.Number & ", description: " &        Err.Description
        Exit Sub

End Sub
`

I get the error on the tdf.fields.append line. Would executing an ALTER TABLE statement be better? What are the tradeoffs?

Answer 1

You can use DDL to create fields:

Long:

CurrentDb.Execute "ALTER TABLE t ADD COLUMN a Long not null", dbFailOnError 

(tack on NOT NULL IDENTITY(1,1) for an autonumber)

CurrentDb.Execute "ALTER TABLE t ADD COLUMN b text(100)", dbFailOnError 

Boolean:

CurrentDb.Execute "ALTER TABLE t ADD COLUMN c Bit not null", dbFailOnError 

DateTime:

CurrentDb.Execute "ALTER TABLE t ADD COLUMN d datetime null", dbFailOnError 

Memo:

CurrentDb.Execute "ALTER TABLE t ADD COLUMN e memo null", dbFailOnError 

Obviously, this lends itself well to functionalization, and you could just pass in your own eternal enum, combined with a Select , to construct the string and execute it:

Public Sub AddFieldToTable(TableName as string, FieldName as string, _
      FieldType as Long, FieldLen as Long, FieldAllowsNull as Boolean)

Dim FieldText as String

Select Case(FieldType)
    Case 0:
        FieldText = "Long"
    Case 1:
        FieldText = "text(" & FieldLen & ")"
    Case 2:
        FieldText = "bit"
    Case 3:
        FieldText = "datetime"
    Case 4:
        FieldText = "memo"

End Select

Dim Sql as string
Sql = "ALTER TABLE " & TableName & " ADD COLUMN " & FieldName & " " & FieldText

If FieldAllowsNull then
   Sql = Sql & " NULL"
Else
   Sql = Sql & " NOT NULL"
End If

CurrentDb.Execute Sql, dbFailOnError

End Sub

Answer 2

I got the code working with either the CreateField or the ALTER TABLE statement. The key here was that I had used a recordset to access the table's data (I needed to check whether the field already existed and/or contained data before I ran the AddField method). I moved the rst.close statement up to before I edited the table structure and it worked! No more 3211.

`
Set db = CurrentDb
Set rst = db.OpenRecordset(strTable)

bFieldExists = Field_Exists(rst, strOutputField) ' Custom field_exists in table function

If bFieldExists then nFieldType = rst(strOutputField).Type

If CheckFieldHasValues(strTable, strOutputField) = True Then ' custom CheckField function
    If MsgBox("The output field has values in it. Proceed?", vbYesNo) = vbNo Then Exit Sub
End If

rst.Close ' Recordset must release the table data before we can alter the table!

If bFieldExists = False Then
    AddFieldToTable strTable, strOutputField, dbCurrency
End If

Set db = Nothing

Answer 3

I just did the following in a module and it works fine

Sub AddTableFields()
    Dim db As DAO.Database
    Dim t As DAO.TableDef
    Dim f As DAO.Field
    Set db = CurrentDb
    Set t = db.TableDefs("tl_LongTermStat")

    Dim intY As Integer
    Dim intQ As Integer

    For intY = 2012 To 2018
        For intQ = 1 To 4
            Set f = t.CreateField("Y" & intY & "Q" & intQ, dbText, 10)
            t.Fields.Append f
        Next
    Next
    Debug.Print "AddTableFields() done"
End Sub