将记录添加到记录集/将字段添加到表

Question

目标：

1. 允许用户创建带有 X 定义字段的自定义表
2. 允许用户输入字段名称

现在，代码能够创建一个包含 1 列的表。这个想法是允许用户创建一个包含 x 定义字段的自定义表，并允许用户定义字段名称。

表名存储在 ExportName 中。 列名存储在Field1中

Dim dbs As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field2
Dim rs As DAO.Recordset2
Dim i As Integer

Set dbs = CurrentDb
Set tbl = dbs.CreateTableDef(Me.ExportName)

Set fld = tbl.CreateField(Field1, dbInteger)
tbl.Fields.Append fld
dbs.TableDefs.Append tbl

鉴于上述目标，建立读取不同字段输入的循环的有效方法是什么？

提前感谢您的帮助。

Answer 1

显然您已经有一个“临时”表（表是永久的，但记录是临时的）来保存用户输入的字段名称和类型。打开这些记录的记录集并循环通过记录集。如果这是一个拆分数据库，并且您希望在后端创建表，则代码必须设置与后端的连接、创建表、设置表链接。下面是我的数据库中的示例。

常量 gstrBasePath 在通用模块头中声明。它是包含前端和后端文件的文件夹的路径：
Global Const gstrBasePath = "\\servername\folderpath\"

Private Sub tbxTestNum_AfterUpdate()

Dim td As TableDef

'check if test table already exists in backend
For Each td In DBEngine.OpenDatabase(gstrBasePath & "\Data\LabData.accdb").TableDefs
    If td.Name = Me.tbxTestNum Then
        MsgBox "Data table for this test already exists in the backend."
        Exit Sub
    End If
Next td
Me.DataField.SetFocus
DoCmd.GoToRecord , , acNewRec

End Sub


Private Sub btnBuild_Click()

On Error GoTo err_Proc

Dim tdf As TableDef
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim db As DAO.Database

CurrentDb.Execute "DELETE FROM BuildTable WHERE DataField <> 'LabNum' AND DataField <> 'method'"

If IsNull(Me.tbxTestNum) Then
    MsgBox "Must enter test number.", vbCritical, "Error"
Else
    Set cn = New ADODB.Connection
    'connect to the backend database
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & gstrBasePath & "Data\LabData.accdb'"
    'create the test table
    cn.Execute "CREATE TABLE " & Me.tbxTestNum & " (LabNum text(12) PRIMARY KEY Not Null, method text(30) Not Null);"

    'set table link
    Set tdf = CurrentDb.CreateTableDef(Me.tbxTestNum)
    tdf.SourceTableName = Me.tbxTestNum
    tdf.Connect = "; DATABASE=" & gstrBasePath & "Data\LabData.accdb"
    CurrentDb.TableDefs.Append tdf

    Set rs = New ADODB.Recordset
    rs.Open "SELECT * FROM BuildTable;", CurrentProject.Connection, adOpenStatic, adLockPessimistic
    'must use DAO to set AllowZeroLength property, I don't allow zero length fields and Access defaults to Yes
    Set db = DBEngine.OpenDatabase(gstrBasePath & "Data\LabData.accdb")
    While Not rs.EOF
        If rs!DataField <> "LabNum" And rs!DataField <> "method" Then
            'create field in new table
            cn.Execute "ALTER TABLE " & Me.tbxTestNum & " ADD COLUMN " & _
                        rs!DataField & " " & IIf(rs!DataType = "Boolean", "Bit", rs!DataType) & _
                        IIf(rs!DataType = "Text", "(" & rs!FieldSize & ")", "") & ";"
        End If
        If rs!DataType = "Text" Then
            'change the AllowZeroLength default Yes to No
            db.TableDefs(Me.tbxTestNum).Fields(rs!DataField).AllowZeroLength = False
        ElseIf rs!DataType = "Number" Then
            'make sure number field DefaultValue not set to 0
            db.TableDefs(Me.tbxTestNum).Fields(rs!DataField).DefaultValue = ""
        End If
        rs.MoveNext
    Wend

    rs.Close
    cn.Close
    db.Close

End If

Me.tbxTestNum.SetFocus

Exit_proc:
    Exit Sub

err_Proc:
    MsgBox "Error encountered in AddDataTable procedure btnBuild_Click - " & Err & " : " & Err.Description
    Resume Exit_proc

End Sub

如果允许多个用户运行此进程，请将此表放在前端或使用用户 ID 保存记录，然后打开过滤到该 ID 的记录集。此外，DELETE 操作必须包含此过滤器。

但是，我不建议实现允许用户修改数据库设计的代码。