Добавить записи в набор записей / Добавить поля в таблицу - PullRequest
Новая
       36

Добавить записи в набор записей / Добавить поля в таблицу

0 голосов
/ 23 января 2019

Цель:

  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

Учитывая вышеперечисленные цели, каков эффективный способ настроить цикл, который считывает различные входные данные поля?

Заранее спасибо за помощь.

1 Ответ

0 голосов
/ 23 января 2019

Очевидно, у вас уже есть таблица 'temp' (таблица постоянная, но записи временные) для сохранения ввода пользователем имен и типов полей. Откройте набор записей этих записей и переберите набор записей. Если это разделенная база данных, и вы хотите, чтобы таблица создавалась в бэкэнде, код должен установить соединение с бэкэндом, создать таблицу, установить ссылку на таблицу. Пример из моей базы данных ниже.

Константа 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

Если нескольким пользователям разрешено запускать этот процесс, поместите эту таблицу во внешний интерфейс или сохраните записи с идентификатором пользователя, а затем откройте набор записей, отфильтрованный по этому идентификатору. Кроме того, действие DELETE должно включать этот фильтр.

Однако я не рекомендую реализовывать код, который позволяет пользователям изменять дизайн БД.

...