That is correct.
Except I am using ADO for creating table and DAO to modify.
Code:
Private Sub tbxTestNum_AfterUpdate()
Dim td As TableDef
'check if test table already exists
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
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 does not have 0 as DefaultValue
db.TableDefs(Me.tbxTestNum).Fields(rs!DataField).DefaultValue = ""
End If
rs.MoveNext
Wend
rs.Close
cn.Close
db.Close
If IsNull(DLookup("DataTable", "TestsFieldAlias", "DataTable='" & Me.tbxTestNum & "'")) Then
'add records to TestsFieldAlias table, this table associates field names of the test tables to field names of Specs and legacy dBase tables
CurrentDb.Execute "INSERT INTO TestsFieldAlias (DataTable, DataField, Alias, Specification, Transfer) " & _
"SELECT " & Me.tbxTestNum & " AS DataTable, DataField, Alias, Specification, Transfer " & _
"FROM BuildTable WHERE Specification = -1 Or Transfer = -1;"
'purge BuildTable
DoCmd.RunSQL "DELETE FROM BuildTable WHERE DataField <> 'LabNum' AND DataField <> 'method'"
Else
MsgBox "Records for this test number already exist in TestsFieldAlias table."
End If
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