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

时间:2014-06-23 14:49:14

标签: vba ms-access

我需要将一个计算字段添加到现有表中。我知道有两种方法可以做到这一点,我想知道是否有人对哪种方法最好以及如何使它们有效:

  1. 使用TableDef.CreateField,然后使用TableDef.Fields.Append
  2. 使用DDL Alter Table ADD COLUMN语句
  3. 我尝试使用第一种方法,但我一直收到3211错误,因为Access无法锁定表。我没有打开桌子。但是,我从一个访问表中当前存在的字段的表单调用CreateField。

    以下是调用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
    `
    

    我在tdf.fields.append行上收到错误。执行ALTER TABLE语句会更好吗?有什么权衡?

3 个答案:

答案 0 :(得分:5)

您可以使用DDL创建字段:

长:

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

(在NOT NULL IDENTITY(1,1)上获取自动编号)

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

布尔值:

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

日期时间:

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

备注:

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

显然,这很适合功能化,你可以传入你自己的永恒枚举,结合Select来构造字符串并执行它:

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

答案 1 :(得分:1)

我得到的代码使用CreateField或ALTER TABLE语句。这里的关键是我使用了一个记录集来访问表的数据(在运行AddField方法之前,我需要检查字段是否已经存在和/或包含数据)。在我编辑表结构之前,我将rst.close语句移动到了它的工作状态!不再是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

答案 2 :(得分:1)

我只是在模块中执行了以下操作,效果很好

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