Copying Access Tables Between Databases

[Ptrace]

Hi,
Yesterday I posted a problem about copying an Access table from one database to another using vb6. Well I got it sussed. This copy includes the complete copy of the table structure, indexes etc. Take a look at it and if it is of any use to anyone, then thats good, but if anyone notices anything that perhaps could do with changing then give me a shout.


Function CopyStruct(vFromDB As Database, vToDB As Database, vFromName As String, vToName As String, bCreateIndex As Integer) As Integer
' This function will be responsible for copying the structure, including the indexes,
' of the selected table to the selected database

On Error GoTo CSErr

' Declare variables
Dim i As Integer
Dim tblTableDefObj As New DAO.TableDef
Dim fldFieldObj As New DAO.Field
Dim indIndexObj As Index
Dim tdf As New DAO.TableDef
Dim fld As New DAO.Field
Dim idx As Index

' For Each tdf In vToDB.Tabledefs check if the table already exists, if so delete it
For i = 0 To vToDB.TableDefs.Count - 1
Set tdf = vToDB.TableDefs(i)
If UCase(tdf.Name) = UCase(vToName) Then
vToDB.TableDefs.Delete tdf.Name
If Len(vToName) = 0 Then
Exit Function
End If
Exit For
End If
Next

' Create the new table definition
Set tblTableDefObj = vFromDB.CreateTableDef()

' Set the name of the created table def to that specified
tblTableDefObj.Name = vToName

' create the fields
' For Each fld In vFromDB.Tabledefs(vFromName).Fields
For i = 0 To vFromDB.TableDefs(vFromName).Fields.Count - 1
Set fld = vFromDB.TableDefs(vFromName).Fields(i)
Set fldFieldObj = vFromDB.TableDefs(vFromName).CreateField(fld.Name, fld.Type, fld.Size)
tblTableDefObj.Fields.Append fldFieldObj
Next

'create the indexes
If bCreateIndex <> False Then
' For Each idx In vFromDB.Tabledefs(vFromName).Indexes
For i = 0 To vFromDB.TableDefs(vFromName).Indexes.Count - 1
Set idx = vFromDB.TableDefs(vFromName).Indexes(i)
Set indIndexObj = vFromDB.TableDefs(vFromName).CreateIndex(idx.Name)
With indIndexObj
indIndexObj.Fields = idx.Fields
indIndexObj.Unique = idx.Unique
If gsDataType <> gsSQLDB Then
indIndexObj.Primary = idx.Primary
End If
End With
tblTableDefObj.Indexes.Append indIndexObj
Next
End If

' append the new table
vToDB.TableDefs.Append tblTableDefObj

CopyStruct = True
Exit Function

CSErr:
ShowError
CopyStruct = False
End Function



Function CopyData(rFromDB As Database, rToDB As Database, rFromName As String, rToName As String) As Integer
' This function copies data from one table to another, between seperate databases

On Error GoTo CopyErr

Dim recRecordset1 As DAO.Recordset, recRecordset2 As DAO.Recordset
Dim i As Integer
Dim nRC As Integer
Dim fld As New DAO.Field

' open both recordsets
Set recRecordset1 = rFromDB.OpenRecordset(rFromName)
Set recRecordset2 = rToDB.OpenRecordset(rToName)

gwsMainWS.BeginTrans

While recRecordset1.EOF = False
recRecordset2.AddNew
' this loop copies the data from each field to
' the new table

' For Each fld In recRecordset1.Fields
For i = 0 To recRecordset1.Fields.Count - 1
Set fld = recRecordset1.Fields(i)
recRecordset2(fld.Name).Value = fld.Value
Next

recRecordset2.Update
recRecordset1.MoveNext
nRC = nRC + 1

'this test will commit transactions every 1000 records
If nRC = 1000 Then
gwsMainWS.CommitTrans
gwsMainWS.BeginTrans
nRC = 0
End If
Wend

gwsMainWS.CommitTrans

CopyData = True
Exit Function

CopyErr:
gwsMainWS.Rollback
ShowError
CopyData = False
End Function



Private Sub btnSubmit_Click()
' Declare variables
Dim tdfTmsemp As New TableDef
Dim dbsource As Database
Dim dbdest As Database

' Show mouse pointer as Hourglass when executing routine
Screen.MousePointer = 11

' Create Microsoft Jet Workspace object.
Set gwsMainWS = CreateWorkspace(&quot;&quot;, &quot;admin&quot;, &quot;&quot;, dbUseJet)

' Set the source database
Set dbsource = gwsMainWS.OpenDatabase(&quot;\\SERVER\SourceDB.mdb&quot;, True, True)

' Set the destination database
Set dbdest = gwsMainWS.OpenDatabase(&quot;\\SERVER\DestDB.mdb&quot;, True, False)

' Call the function 'CopyStruct' to copy to DestDB.mdb, the structure of the
' [Absentees] table
Call CopyStruct(dbsource, dbdest, &quot;Table Copied&quot;, &quot;Table Copied To&quot;, True)

' Call the function 'CopyData', which will copy the necessary data to the created
' table, [Absentees]
Call CopyData(dbsource, dbdest, &quot;Table Copied&quot;, &quot;Table Copied To&quot

' Close the workspace and database connections
gwsMainWS.Close
Set dbsource = Nothing
Set dbdest = Nothing

' Return the mouse pointer to 'normal'
Screen.MousePointer = 0

End Sub


PTrace

 

[MichaelRed]

While this may work, I wonder if simply copying the entire objects (DoCmd.CopyObject ... ), along with a query to delete all of the records in the tables wouldn't be at least easier to &quot;read&quot;? MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[muesli]

I'd have a look at the SELECT..INTO statement if I were you. You can select a numebr of fields from on table straight into another: if the table doesn't exist, it creates it.

 

[CCLINT]

Yes, SELECT INTO is much, much easier under ADO or DAO.....
Thanks anyways.