Copy Table Using ADOX in Access 2K

[mincefish]

Hello, hope I've picked the right forum here!

I need to make an exact copy of a table, and rename it something similar, just without any of the data. I'm using Access 2K here.

I am basically trying to automate the process where-by a user manually selects a table, copies it, and then clicks on paste. When they click on paste, they get the options to Paste: Structure Only, Structure and Data, or Append Data To Existing Table. I want to replicate choosing option Structure Only.

So far I've worked out how to create a table with the same fields, field types, and sizes, but I need to make sure I am also getting any indexes, and PKs.

Here is my code so far:

Function fncCopyStructure(strTable As String, strNewTable As String)
On Error Resume Next
'This function takes a table, opens it up (using ADOX), and then recreates the table with the defined new name.
'It matches with name, field type and defined size

Dim tblNew As New ADOX.Table ' new table created
Dim tblTemp As ADOX.Table ' Existing table to be copied
Dim colTemp As ADOX.Column ' Column collection
Dim catTemp As New ADOX.Catalog ' catalog - to open tables collection

catTemp.ActiveConnection = CurrentProject.Connection
Set tblTemp = catTemp.Tables(strTable)

tblNew.Name = strNewTable

For Each colTemp In tblTemp.Columns
    tblNew.Columns.Append colTemp.Name, colTemp.Type, colTemp.DefinedSize
Next

catTemp.Tables.Append tblNew

End Function

I realise I'm not tidying up at the end - that's the least of my concerns!!!

I did wonder about simply using a make table query, but will the indexes and keys be replicated?

Thanks for any help anyone can give me!!

Tom

 

[mincefish]

No-one answered this, and I wasn't sure why. Anyway, I worked out how to do it, and I thought I'd paste the code here, incase someone is searching for the answer to the same question, and stumbles across this question.

These two functions take input of the name of the old table (to be copied), the name of the new table (to the created as a mirror of the old table), and a connection string. If the connection string is a nullstring, then CurrentProject.Connection is presumed.

This is all done using ADOX 2.5, in Access 2K

Function fncCopyTable(strTableExist As String, strTableNew As String, Optional strConn As String)
Dim catCurr As New ADOX.Catalog ' catalog - 
Dim rstFields As New ADODB.Recordset ' recordset to get fields in table IN ORDER!
Dim tblExist As ADOX.Table ' existing table - to be copied
Dim tblNew As New ADOX.Table ' new table - to be created
Dim fldFields As ADODB.Field 'field collection in recordset
Dim idxExist As ADOX.Index 'index collection in existing table

'if a connection has been provided, then use it. Otherwise use CurrentProject.Connection
If strConn = vbNullString Then
    catCurr.ActiveConnection = CurrentProject.Connection
Else
    catCurr.ActiveConnection = strConn
End If

'Open up existing table
Set tblExist = catCurr.Tables(strTableExist)

'set the name of the new table
tblNew.Name = strTableNew

'open up a recordset to get the fields in existing table.
'We have to use an rst, and not ADOX tbl, cos the table collection alphabetises the tables, and
'doesn't present them in the same order as they are in the table
rstFields.ActiveConnection = CurrentProject.Connection
rstFields.Open "SELECT * FROM [" & strTableExist & "] WHERE 1 = 0"

'loop through rst.Fields collection, and create a new column in the new table
For Each fldFields In rstFields.Fields
    tblNew.Columns.Append fldFields.Name, fldFields.Type, fldFields.DefinedSize
Next

'append table to collection
catCurr.Tables.Append tblNew

'close recordset if still open - we don't need it any more
If rstFields.State = adStateOpen Then rstFields.Close
       
'For each index in the index collection of the existing table loop call the Create Index function

For Each idxExist In tblExist.Indexes
    Call fncCreateIndex(strTableNew, idxExist.Name, idxExist.IndexNulls, _
                                    idxExist.Columns(0), idxExist.PrimaryKey, catCurr.ActiveConnection)
Next

'clean down variables
Set catCurr = Nothing
Set tblExist = Nothing
Set tblNew = Nothing
Set idxExist = Nothing

End Function

Function fncCreateIndex(strTableName As String, strName As String, _
                                    lngIndexNulls As ADOX.AllowNullsEnum, strIndexField As String, _
                                    blPKey As Boolean, Optional strConn As String)
Dim catCurr As New ADOX.Catalog
Dim tblNew As ADOX.Table
Dim idxNew As ADOX.Index

'set connection
If strConn = vbNullString Then
    catCurr.ActiveConnection = CurrentProject.Connection
Else
    catCurr.ActiveConnection = strConn
End If

'open new ADOX Table
Set tblNew = New ADOX.Table

'set the table to the name passed thru'
Set tblNew = catCurr.Tables(strTableName)

'open up the index collection on the table
Set idxNew = New ADOX.Index

'set the index up
With idxNew
    .Name = strName
    .IndexNulls = lngIndexNulls
    .PrimaryKey = blPKey
    .Columns.Append strIndexField
End With

'append index to table collection
tblNew.Indexes.Append idxNew

'Clean down variables
Set catCurr = Nothing
Set tblNew = Nothing
Set idxNew = Nothing

End Function

I hope this helps someone somewhere! Let me know if it does!!

Regards,

Mincefish