Copy table structure in Access

[ufjessey]

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.

[MartinLiss]

Here is a routine that copies a table. You can probably modify it to just copy the structure.

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

[ufjessey]

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!

[MartinLiss]

Here's the code for creating a primary key. I'll get back to you on setting up a default.

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

[ufjessey]

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.

[MartinLiss]

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

[MartinLiss]

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