vbams-access

Access Duplicate Table with properties like Lookup Field


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


Solution

  • It is much easier using DoCmd.TransferDatabase method (Access) :

    DoCmd.TransferDatabase acExport, "Microsoft Access", CurrentDb.Name, actable, "RA", "RA_Duplicate"