Question

我想知道是否可以使用VBA来存储，删除和重新创建Access VBA中表的关系？删除部分很简单，但是如何以删除部分后的方式存储它就是我被卡住的地方。

我原本想知道，以便我可以将某些数据库中的某些表批量复制到该数据库的另一个副本中。我作为裁判遇到了麻烦。桌子上的完整性干扰了插入物。我想过尝试存储然后删除关系，插入数据，然后使用DAO恢复关系。

在考虑了它并试图为它提出一些代码之后，我放弃了这个想法并以不同的方式插入它以完全避免这个问题。然而，在事实之后，我正在思考我一直在尝试的是否可行。

有什么想法吗？

编辑：这是我开始编写的代码。

Private Sub Save_Click()
    Dim db As DAO.Database

    Set db = CurrentDb
    'Save db.Relations somehow as SavedRelations
End Sub

Private Sub Delete_Click()
    Dim db As DAO.Database
    Dim rel As DAO.Relation

    Set db = CurrentDb

    For Each rel In db.Relations
        db.Relations.Delete (rel.Name)
    Next
End Sub

Private Sub Restore_Click()
    Dim db As DAO.Database
    Dim rel As DAO.Relation
    Dim newRel As DAO.Relation

    For Each rel In SavedRelations 'Stored relations from the Save sub
        Set newRel = db.CreateRelation(rel.Name, rel.table, rel.ForeignTable, rel.Attributes)
        For Each fld In rel.Fields
            newRel.Fields.Append fld
        Next
        db.Relations.Append newRel
    Next
End Sub

Answer 1

如果在删除关系之前制作数据库的备份副本，则可以稍后将其复制回来。

Private Sub Restore_Click()
    Dim db As DAO.Database
    Dim dbBackup As DAO.Database
    Dim rel As DAO.Relation
    Dim newRel As DAO.Relation

    Set db = CurrentDb()
    Set dbBackup = OpenDatabase("C:\temp\backup.mdb")
    For Each rel In dbBackup.Relations 
        Set newRel = db.CreateRelation(rel.Name, rel.table, rel.ForeignTable, _
            rel.Attributes)
        For Each fld In rel.Fields
            newRel.Fields.Append newRel.CreateField(fld.Name)
            newRel.Fields(fld.Name).ForeignName = _
                rel.Fields(fld.Name).ForeignName
        Next fld
        db.Relations.Append newRel
    Next rel
    Set fld = Nothing
    Set rel = Nothing
    Set dbBackup = Nothing
    Set db = Nothing
End Sub

Answer 2

以下代码将创建一个经典的父对子关系

  Dim nRel          As DAO.Relation
  Dim db            As DAO.Database

  Set db = CurrentDb

  Set nR = db.CreateRelation("ContactIDRI", "tblContacts", _
                             "tblChildren", dbRelationDeleteCascade + dbRelationLeft)

  nR.Fields.Append nR.CreateField("ContactID")        ' parent table PK
  nR.Fields("ContactID").ForeignName = "Contact_ID"   ' child table FK
  db.Relations.Append nR
  db.Relations.Refresh

Answer 3

好工作HansUp！我稍微修改了它以允许后期绑定文件浏览器。对不起伙计......我花了一些编辑来解决这些“代码块”指令。希望现在就是:(

    Function selectFile()
'Late binding version of selectFile
'No MS Office Object references needed
'''''''''''''''''''''''''''''''''''''''
'http://www.minnesotaithub.com/2015/11/solved-late-binding-file-dialog-vba-example/
Dim fd As Object
Set fd = Application.FileDialog(3)

With fd
    If .Show Then
        selectFile = .SelectedItems(1)
    Else
        End
    End If
End With

Set fd = Nothing
End Function


    Public Function fRestoreRelationships()
'http://stackoverflow.com/questions/4028672/storing-and-recreating-relations-in-access

Dim db As DAO.Database
Dim dbBackup As DAO.Database
Dim rel As DAO.Relation
Dim newRel As DAO.Relation
Dim strBackupPath As String
Dim Msg As String
Dim CR As String
CR = vbCrLf
Msg = ""
Msg = Msg & "This procedure restores the relationships from a previous backup." & CR & CR
Msg = Msg & "If you would like to proceed with this operation, " & CR
Msg = Msg & "Please click on the [OK] button " & CR
Msg = Msg & "Otherwise click [Cancel] to exit this pocedure."

If MsgBox(Msg, vbOKCancel, "Proceed?") = vbOK Then

        strBackupPath = selectFile 'Calls a FileBrowser Dialog and returns a string value
        Set db = CurrentDb()
        Set dbBackup = OpenDatabase(strBackupPath)
        For Each rel In dbBackup.Relations
            Set newRel = db.CreateRelation(rel.Name, rel.Table, rel.ForeignTable, _
                rel.Attributes)
            For Each fld In rel.Fields
                newRel.Fields.Append newRel.CreateField(fld.Name)
                newRel.Fields(fld.Name).ForeignName = _
                    rel.Fields(fld.Name).ForeignName
            Next fld
            db.Relations.Append newRel
        Next rel
End If

Set fld = Nothing
Set rel = Nothing
Set dbBackup = Nothing
Set db = Nothing
End Function

在Access中存储和重新创建关系

3 个答案: