Question

目标：

允许用户使用X个定义的字段创建自定义表格
允许用户输入字段名称

现在，该代码能够创建具有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操作必须包含此过滤器。

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

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

1 个答案: