copy a table at runtime

[badgers]

This relates to some of my other posts:
I want to create a copy of a table1 in an access database. This copy will have the name which equalls the caption of a newly created mdi child form.
How do I copy the table, and give it a name?
thank you for your time and have a good day

[MartinLiss]

Here's a start

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

[badgers]

thank you very much

[badgers]

what references do I need to run that sub?

[MartinLiss]

I use the Microsoft DAO 2.5/3.5 Compatibility Library (it's an old program), but with a few tweaks you can convert it to DAO 3.51 or even ADO. Email me if you need specifics.