用于创建 MS Access 关系的 VBA 代码

• 下载源代码 - 1.19 KB

引言

以下文章介绍了如何使用 VBA 宏在 MS Access 中创建关系。

背景

我一直很难使用“关系”窗口在 MS Access 数据库中创建和管理关系。特别是当您有很多表以及它们之间的关系时。我在 Google 和 CodeProject 中搜索并没有找到帮助，最终，我开发了这个 VB 宏来自动化关系。

使用代码

代码非常简单明了。

下载 zip 文件 (RelationshipCreator.zip - 1.19 KB)。解压缩并在您的 MS Access 数据库中将其添加为模块。

主函数是 CreateAllRelations()，它调用函数 CreateRelation()。如以下示例所示，您需要使用以下参数调用函数 CreateRelation() -- 基表的名称、基表中的字段名称、外表名称以及外表中的字段名称。对您想要创建的每个关系重复此操作。主函数首先删除所有关系，然后重新创建它们。

为每个关系输入这些信息可能很繁琐。但是一旦您有了这个，您就可以通过运行名为 CreateAllRelations() 的宏函数来随时删除和创建关系。

Public Function CreateAllRelations()

    Dim db As DAO.Database
    Dim totalRelations As Integer
    
    Set db = CurrentDb()
    totalRelations = db.Relations.Count
    If totalRelations > 0 Then
        For i = totalRelations - 1 To 0 Step -1
            db.Relations.Delete (db.Relations(i).Name)
        Next i
        Debug.Print Trim(Str(totalRelations)) + " Relationships deleted!"
    End If
    
    Debug.Print "Creating Relations..."
    
    ''==========================
    ''Example
    'Employee Master to Employee CheckIn
    Debug.Print CreateRelation("Employee", "Code", _
                               "CheckIn", "Code")
    
    ''Orders to Order Details
    Debug.Print CreateRelation("Orders", "No", _
                               "OrderDetails", "No")
    ''==========================
    
    totalRelations = db.Relations.Count
    Set db = Nothing
    
    Debug.Print Trim(Str(totalRelations)) + " Relationships created!"
    Debug.Print "Completed!"
End Function

Private Function CreateRelation(primaryTableName As String, _
                                primaryFieldName As String, _
                                foreignTableName As String, _
                                foreignFieldName As String) As Boolean
On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim newRelation As DAO.Relation
    Dim relatingField As DAO.Field
    Dim relationUniqueName As String
    
    relationUniqueName = primaryTableName + "_" + primaryFieldName + _
                         "__" + foreignTableName + "_" + foreignFieldName
    
    Set db = CurrentDb()
    
    'Arguments for CreateRelation(): any unique name, 
    'primary table, related table, attributes.
    Set newRelation = db.CreateRelation(relationUniqueName, _
                            primaryTableName, foreignTableName)
    'The field from the primary table.
    Set relatingField = newRelation.CreateField(primaryFieldName)
    'Matching field from the related table.
    relatingField.ForeignName = foreignFieldName
    'Add the field to the relation's Fields collection.
    newRelation.Fields.Append relatingField
    'Add the relation to the database.
    db.Relations.Append newRelation
    
    Set db = Nothing
    
    CreateRelation = True
        
Exit Function

ErrHandler:
    Debug.Print Err.Description + " (" + relationUniqueName + ")"
    CreateRelation = False
End Function

历史

无。