Here's a start
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 PrintDetailRpt "CopyTable", FOUND_ERROR Else PrintDetailRpt "", OK End If End Sub




Reply With Quote