Copying tables

[netSurfer]

What is the best way to copy and rename1 table in a database? Basically, I need to take existing tables and make a copy of them. I'm not sure the best way to do this.

[MartinLiss]

Use this subroutine which uses DAO 2.5/3.5. You should update it to use DAO 3.51 and to do that you'll have to modify a few things. You'll also need to modify/add a few things like the database definitions and the ErrorRoutine but it's easier than staring from scratch.

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
        PrintDetailRpt "CopyTable", FOUND_ERROR
    Else
        PrintDetailRpt "", OK
    End If

End Sub

[netSurfer]

Nuts. Thanks Martin, I was really hoping there was an easier way than that :-( Something easy that would just take the name of a tale and copy it with a new name. Oh well. Thanks.

[pardede]

If you only need the fields-structure then you might have a shot using sql like:

SELECT * INTO new_table FROM from_table WHERE false

[MartinLiss]

Well, while there is a lot of what I suppose is imposing looking code, it's really not that complex, and if you don't get a more satisfying answer, why not give it a shot? If you decide to try it, and you run into problems, email me.

[netSurfer]

Martin - I know that it's not really complex code - it's just going to be a time consuming process when I'm dealing with multiple tables with alot of records. But if Pardede's suggestion doesn't work I'll have to do it that way. Thanks for the code :-)

Pardede - I'll try that thanks. I hope that works.

[Serge]

Let's say you have tables that you want to copy to the same database with different names (in this example i'm going to add 1 at the end of each table name).

Private Sub Command1_Click()
    Dim db As Database
    Dim tbl As TableDef
    Dim i As Integer
    Dim strSQL As String
    
    On Error Resume Next
    
    Set db = Workspaces(0).OpenDatabase("D:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb")
    
    For Each tbl In db.TableDefs
        If tbl.Attributes = 0 Then
            strSQL = "Select * Into " & tbl.Name & "1 From " & tbl.Name
            db.Execute strSQL, dbFailOnError
        End If
    Next
End Sub

This will copy all tables except System tables.