Hi I have a table called “RA” and some fields are Lookup Field (hope it's called that in english) so when I click on the cells in this column dropdown opens and I can select multiple things from another table. I would like to duplicate the table “RA” 1-1 with properties, so if the table RA 2nd column is Lookup Field, the duplicate should also be Lookup Field. I am quite new to access VBA and I have found a code on the internet. The table is duplicated but the properties Lookup Field etc. are not copied. I would appreciate some help.
here is my code so far, what i found on internet:
Sub DuplicateRATable()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim index As DAO.Index
Dim rel As DAO.Relation
Dim newTableName As String
' Set the current database
Set db = CurrentDb()
' Define the new table name
newTableName = "RA_Duplicate"
' Check if the new table already exists and delete if it does
On Error Resume Next
db.TableDefs.Delete newTableName
On Error GoTo 0
' Copy the original table
db.Execute "SELECT * INTO " & newTableName & " FROM RA", dbFailOnError
' Get the original table definition
Set tdf = db.TableDefs("RA")
' Loop through the fields of the original table and copy combo box properties
For Each fld In tdf.Fields
On Error Resume Next
' Check if the field is a combo box
If fld.Properties("DisplayControl").Value = acComboBox Then
Dim prop As DAO.Property
Dim newFld As DAO.Field
Set newFld = db.TableDefs(newTableName).Fields(fld.Name)
' Copy combo box properties
For Each prop In fld.Properties
On Error Resume Next
newFld.Properties(prop.Name).Value = prop.Value
On Error GoTo 0
Next prop
End If
On Error GoTo 0
Next fld
' Copy indexes
For Each index In tdf.Indexes
On Error Resume Next
' Create a new index
Dim newIndex As DAO.Index
Set newIndex = db.TableDefs(newTableName).CreateIndex(index.Name)
' Add fields to the new index
For Each fld In index.Fields
newIndex.Fields.Append newIndex.CreateField(fld.Name)
Next fld
' Copy index properties
newIndex.Primary = index.Primary
newIndex.Unique = index.Unique
newIndex.IgnoreNulls = index.IgnoreNulls
newIndex.Required = index.Required
' Append the new index to the new table
db.TableDefs(newTableName).Indexes.Append newIndex
On Error GoTo 0
Next index
' Copy relationships
For Each rel In db.Relations
If rel.Table = tdf.Name Or rel.ForeignTable = tdf.Name Then
On Error Resume Next
Dim newRel As DAO.Relation
Set newRel = db.CreateRelation(rel.Name, newTableName, rel.ForeignTable, rel.Attributes)
For Each fld In rel.Fields
newRel.Fields.Append newRel.CreateField(fld.Name)
newRel.Fields(fld.Name).ForeignName = fld.ForeignName
Next fld
db.Relations.Append newRel
On Error GoTo 0
End If
Next rel
MsgBox "The table '" & newTableName & "' has been successfully duplicated."
End Sub
It is much easier using DoCmd.TransferDatabase method (Access) :
DoCmd.TransferDatabase acExport, "Microsoft Access", CurrentDb.Name, actable, "RA", "RA_Duplicate"