Хранение и воссоздание отношений в Access - PullRequest
Новая
       3

Хранение и воссоздание отношений в Access

2 голосов
/ 27 октября 2010

Мне интересно, возможно ли использовать 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

Ответы [ 3 ]

5 голосов
/ 27 октября 2010

Если вы сделаете резервную копию своей базы данных до того, как удалите отношения, вы можете скопировать их позже. 

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
1 голос
/ 27 октября 2010

Следующий код создаст классические отношения родитель-потомок 

  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
0 голосов
/ 17 апреля 2017

Отличная работа 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()
'/2808021/hranenie-i-vossozdanie-otnoshenii-v-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
...