在Access VBA中创建表关系的循环

Question

我尝试使用以下代码创建一个表关系，并且可以正常工作。

Dim rel As New Relation
Dim db As DAO.Database
Dim fld As DAO.Field

Set db = CurrentDb

rel.Attributes = dbRelationDontEnforce + dbRelationRight
rel.Name = "RelationName"
rel.Table = "tblParent"
rel.ForeignTable = "tblChild"

Set fld = rel.CreateField("FieldID")

fld.Name = "FieldID"
fld.ForeignName = "FieldID"
rel.Fields.Append fld
db.Relations.Append rel

当我尝试循环它以通过查询“ QryRelaDict”创建多个关系时，如下所示。它在第一个循环中创建了第一个关系，在第二个循环中，它以rel.Attributes = dbRelationEnforce停在run time error 3219: invalid operation。任何人都可以帮助循环创建实境吗？非常感谢。

   Dim db As DAO.Database
   Dim daRs As DAO.Recordset    
   Dim rel As New Relation
   Dim fld As DAO.Field

   Set db = CurrentDb
   Set daRs = db.OpenRecordset("QryRelaDict")

    Do While Not daRs.EOF

        Debug.Print daRs!tblPare & "-" & daRs!tblChil

        rel.Attributes = dbRelationEnforce 
        rel.Name = daRs!tblPare & "-" & daRs!tblChil & "-" & daRs!AAA
        rel.Table = daRs!tblPare
        rel.ForeignTable = daRs!tblChil

        Set fld = rel.CreateField(daRs!AAA)

        fld.Name = daRs!AAA
        fld.ForeignName = daRs!AAA

        rel.Fields.Append fld
        db.Relations.Append rel

        daRs.MoveNext
    Loop

Answer 1

此问题需要答案。在评论中找到它：

在您的循环中，添加Set rel = New Relation

示例：

   Dim db As DAO.Database
   Dim daRs As DAO.Recordset    
   Dim rel As Relation
   Dim fld As DAO.Field

   Set db = CurrentDb
   Set daRs = db.OpenRecordset("QryRelaDict")

   Do While Not daRs.EOF
        Set rel = New Relation
        Debug.Print daRs!tblPare & "-" & daRs!tblChil

        rel.Attributes = dbRelationEnforce 
        rel.Name = daRs!tblPare & "-" & daRs!tblChil & "-" & daRs!AAA
        rel.Table = daRs!tblPare
        rel.ForeignTable = daRs!tblChil

        Set fld = rel.CreateField(daRs!AAA)

        fld.Name = daRs!AAA
        fld.ForeignName = daRs!AAA

        rel.Fields.Append fld
        db.Relations.Append rel

        daRs.MoveNext
   Loop