Copy an access database table using ADO

[johnmacleod10]

I have been trying to figure out how to copy an Access database table using ADO but I have so far been un-sucessful. If it is not possible with ADo what is the best way to carry this task out.
thnaks John

 

[MangroBongacello]

If you want to copy a table from one db to another, here's the routine I use. It uses DAO.

dim dbOriginal as database
dim dbDestination as database
dim tdfsOriginal as tabledefs
dim tdfsDestination as tabledefs
dim tblOriginal as tabledef
dim tblDestination as tabledef
dim fldOriginal as field
dim fldDestination as field

set dbOriginal=OpenDatabase("c:\Original.mdb&quot
set dbDestination=OpenDatabase("c:\Destination.mdb&quot

set tdfsOriginal=dbOriginal.tabledefs
set tdfsDestination=dbDestination.tabledefs

set tblOriginal=tdfsOriginal("NameOfOriginalTable&quot
set tblDestination=tdfsDestination.CreateTableDef("NameOfDestinationTable&quot

For Each fldOriginal In tblOriginal.Fields
Set fldDestination = tblDestination.CreateField(fldOriginal.Name, fldOriginal.Type, fldOriginal.Size)
tblDestination.Fields.Append fldDestination
Next

This routine copies a table structure to a destination mdb. Then I loop through the records in the original table and append them to the destination table.

It works fine for me but if there is a smoother way I would like to see it too. I hope my post will be of help to you. Let me know.

Good luck
Mangro

 

[MangroBongacello]

Oops...

the line

set tblDestination=tdfsDestination.CreateTableDef("NameOfDestinationTable&quot

should be

set tblDestination=dbDestination.CreateTableDef("NameOfDestinationTable&quot

 

[johnmacleod10]

I tried this code above and I get no new table in the database. I am actually wanting to create a new table within the same database and it is just the structure that I need so the above should work. I am not getting any errors. Any ideas? to try it out I substituted the following
I do not see why it should not work

Public Function addnewspec()
Dim dbOriginal As Database
Dim dbDestination As Database
Dim tdfsOriginal As TableDefs
Dim tdfsDestination As TableDefs
Dim tblOriginal As TableDef
Dim tblDestination As TableDef
Dim fldOriginal As Field
Dim fldDestination As Field

Set dbOriginal = OpenDatabase("c:\temp\db1.mdb")
Set dbDestination = OpenDatabase("c:\temp\db2.mdb")

Set tdfsOriginal = dbOriginal.TableDefs
Set tdfsDestination = dbDestination.TableDefs

Set tblOriginal = tdfsOriginal("Blankstrut")
Set tblDestination = dbDestination.CreateTableDef("newspec")

For Each fldOriginal In tblOriginal.Fields
   Set fldDestination = tblDestination.CreateField(fldOriginal.Name, fldOriginal.Type, fldOriginal.Size)
   tblDestination.Fields.Append fldDestination
Next

End Function

 

[MangroBongacello]

Well, my mistake. I forgot to append the newly created table to tabledefs collection. And, if you create a new table within the same database, some modifications must be done:

Public Function addnewspec()
On error goto addnewspec_err
Dim dbOriginal As Database
Dim tdfsOriginal As TableDefs
Dim tblOriginal As TableDef
Dim tblDestination As TableDef
Dim fldOriginal As Field
Dim fldDestination As Field

Set dbOriginal = OpenDatabase("c:\temp\db1.mdb&quot

Set tdfsOriginal = dbOriginal.TableDefs

Set tblOriginal = tdfsOriginal("Blankstrut&quot
Set tblDestination = dbOriginal.CreateTableDef("newspec&quot

For Each fldOriginal In tblOriginal.Fields
Set fldDestination = tblDestination.CreateField(fldOriginal.Name, fldOriginal.Type, fldOriginal.Size)
tblDestination.Fields.Append fldDestination
Next

On error resume next 'ignore error in the next line
tdfsOriginal.delete ("newspec&quot'delete "newspec" if exists
On error goto addnewspec_err
tdfsOriginal.append tblDestination

addnewspec_exit:
exit sub
addnewspec_err:
msgbox err.description
resume addnewspec_exit
End Function

I included error handling, because if the "newspec" table already exists when you run the procedure, an error will occur when you try to append the newly created table to tabledefs collection. So the procedure first deletes the existing "newspec" and then appends the new one.

I hope this will now work for you. Let me know.

Mangro

 

[johnmacleod10]

Thanks Works a treat

John