Printable View
I am going to copy data structure from
another table to a new table within the same mdb file.
Say, there are tb1,tb2 in one mdb file,
and I would like to create table tb3 with
same data structure of tb1.
How can I do that?
Thanks in advance for your kind help.
Here is a routine that copies a table. You can probably modify it to just copy the structure.Code:Public Sub CopyTable(sSourceDB As String, from_nm As String, to_nm As String)
Dim dbSource As Database
Dim nCtr As Integer
Dim tbl As New TableDef
Dim fld As Field
Dim ind As Index
Dim ds1 As Dynaset
Dim ds2 As Dynaset
On Error GoTo ErrorRoutine
Set dbSource = Workspaces(0).OpenDatabase(gsDBPath & sSourceDB)
'Search to see if table exists
For nCtr = 0 To gdbTargetDB.TableDefs.Count - 1
If UCase(gdbTargetDB.TableDefs(nCtr).Name) = UCase(to_nm) Then
gdbTargetDB.TableDefs.Delete gdbTargetDB.TableDefs(nCtr).Name
Exit For
End If
Next
'strip off owner if necessary
If InStr(to_nm, ".") <> 0 Then
to_nm = Mid(to_nm, InStr(to_nm, ".") + 1, Len(to_nm))
End If
tbl.Name = to_nm
'Create the fields
For nCtr = 0 To dbSource.TableDefs(from_nm).Fields.Count - 1
Set fld = New Field
fld.Name = dbSource.TableDefs(from_nm).Fields(nCtr).Name
fld.Type = dbSource.TableDefs(from_nm).Fields(nCtr).Type
fld.Size = dbSource.TableDefs(from_nm).Fields(nCtr).Size
'KV05 Start
If dbSource.TableDefs(from_nm).Fields(nCtr).AllowZeroLength = True Then
fld.AllowZeroLength = True
End If
'KV05 End
fld.Attributes = dbSource.TableDefs(from_nm).Fields(nCtr).Attributes
tbl.Fields.Append fld
Next
'Create the indexes
For nCtr = 0 To dbSource.TableDefs(from_nm).Indexes.Count - 1
Set ind = New Index
ind.Name = dbSource.TableDefs(from_nm).Indexes(nCtr).Name
ind.Fields = dbSource.TableDefs(from_nm).Indexes(nCtr).Fields
ind.Unique = dbSource.TableDefs(from_nm).Indexes(nCtr).Unique
ind.Primary = dbSource.TableDefs(from_nm).Indexes(nCtr).Primary
tbl.Indexes.Append ind
Next
'Append the new table
gdbTargetDB.TableDefs.Append tbl
Set ds1 = dbSource.CreateDynaset(from_nm)
Set ds2 = gdbTargetDB.CreateDynaset(to_nm)
While ds1.EOF = False
ds2.AddNew
For nCtr = 0 To ds1.Fields.Count - 1
ds2(nCtr) = ds1(nCtr)
Next
ds2.Update
ds1.MoveNext
Wend
ErrorRoutine:
If Err.Number <> 0 Then
' Your error processing
End If
End Sub
------------------
Marty
Very appreciated your code.
I used it to code as:
'***************************************
Sub MakeNewTable(tbName As String, from_nm As String)
'tbName is the table to be created
'from_nm is the source table
On Error GoTo error_newTB
Dim Mydb As Database
Set Mydb = OpenDatabase("c:\mdb\my.mdb")
Dim tb As TableDef
Dim ind As Index
Mydb.TableDefs.Refresh
Set tb = Mydb.CreateTableDef(name:=tbName)
'create field and attribute
tb.Fields.Append tb.CreateField(name:="id", Type:=dbLong)
tb.Fields("id").Attributes = tb.Fields("id").Attributes + dbAutoIncrField
'make it autonumber
tb.Fields.Append tb.CreateField(name:="name", Type:=dbText, Size:=50)
tb.Fields.Append tb.CreateField(name:="total", Type:=dbLong)
tb.Fields.Append tb.CreateField(name:="create_date", Type:=dbDate)
tb.Fields.Append tb.CreateField(name:="end_date", Type:=dbDate)
tb.Fields.Append tb.CreateField(name:="desc", Type:=dbMemo)
tb.Fields.Append tb.CreateField(name:="recent_date", Type:=dbDate)
tb.Fields.Append tb.CreateField(name:="flag", Type:=dbText, Size:=1)
Mydb.TableDefs.Append tb
'create index
Dim i As Integer
Set ind = New Index
For i = 0 To Mydb.TableDefs(from_nm).Indexes.Count - 1
ind.name = Mydb.TableDefs(from_nm).Indexes(i).name
ind.Fields = Mydb.TableDefs(from_nm).Indexes(i).Fields
ind.Unique = Mydb.TableDefs(from_nm).Indexes(i).Unique
ind.Primary = Mydb.TableDefs(from_nm).Indexes(i).Primary
tb.Indexes.Append ind
Next
Mydb.Close
Send ("OK")
Exit Sub
error_newTB:
Send ("ERROR")
End Sub
'*****************************************
But I got two questions:
(1)How to make id as [main] primary index?
(2)How to make default value for a certain field I created?
Thanks all!
Here's the code for creating a primary key. I'll get back to you on setting up a default.------------------Code:Public Sub AddPrimaryKey(sTableName As String, sFieldName As String)
Dim ndxIndex As Index
Dim tdTableDef As TableDef
Dim fldField As Field
Dim nChars As Integer
Dim nColons As Integer
Dim sCurrChar As String
Dim sFields(5) As String
Dim nCtr As Integer
On Error GoTo ErrorRoutine
Erase sFields()
'Parse the names of the fields to be included in the index
For nChars = 1 To Len(sFieldName)
sCurrChar = Mid(sFieldName, nChars, 1)
If sCurrChar = ":" Then
nColons = nColons + 1
If nColons > 4 Then
gsErrText = "Too many fields in index"
Err.Raise 10007
End If
Else
sFields(nColons) = sFields(nColons) & sCurrChar
End If
Next
Set tdTableDef = gdbTargetDB.TableDefs(sTableName)
'Create new Index object.
Set ndxIndex = tdTableDef.CreateIndex(sFields(0))
ndxIndex.Primary = True
ndxIndex.Unique = True
ndxIndex.Name = "PrimaryKey"
For nCtr = 0 To nColons
Set fldField = ndxIndex.CreateField(sFields(nCtr))
ndxIndex.Fields.Append fldField
Next
'Save Index definition by appending it to Indexes collection.
tdTableDef.Indexes.Append ndxIndex
ErrorRoutine:
If Err.Number <> 0 Then
' Your error processing
End If
End Sub
Marty
Thanks for your big help...
I finished the structure copy, primary key
and default value setting.
For the default value setting, not only for the text field, it also can use for the date or other type, but for the date type, we should set the value to string like "now()",insead of now().
Appreciate your big favor again.
I'm not sure if you are asking a question or not, but to initialize a date, use Now() with no quotes, and if you need t0 initialize numbers, use the number without quotes.
------------------
Marty
Through experimentation I found that the default value for a field is the 12th property, so something like the following should allow you to set the default (for a Text field in this example) although I didn't test it.
DB.TableDefs("MyTable").Fields(MyFieldNumber).Properties(12) = "This is the default"
------------------
Marty