使用查找字段等属性访问重复表

Question

您好，我有一个名为“RA”的表，有些字段是查找字段（希望它是英文的），因此当我单击此列中的单元格时，下拉列表将打开，我可以从另一个表中选择多个内容。 我想复制带有属性的表“RA”1-1，因此如果表 RA 第二列是查找字段，则重复项也应该是查找字段。 我对 VBA 很陌生，我在互联网上找到了代码。该表被复制，但属性查找字段等未被复制。我希望得到一些帮助。

这是我到目前为止在互联网上找到的代码：

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

Answer 1

使用 DoCmd.TransferDatabase 方法（Access）更容易 :

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