Option Explicit
 
Public Sub ReplaceForeignKey(Db As DAO.Database, PrimaryTable As String, _
    ExpiredKey As Long, ReplacementKey As Long)
    ' Geht alle Relations der Datenbank durch, die mit der Primärtabelle in 
    ' Beziehung
    ' stehen und ersetzt dort in den Fremdschlüsselfeldern den ExpiredKey _
    ' durch den ReplacementKey. Wird eingesetzt bei der Eliminierung von 
    ' Duplikaten.
    ' Parameter
    '   Db = Database Objekt, in der sich die Tabellen befinden müssen.
    '   PrimaryTable = Name der refernzierten Primärtabelle
    '   ExpiredKey = ID des Records, das ersetzt werden soll
    '   ReplacementKey = ID des ErsatzRecords.
    On Error GoTo Hell
    ' Alle Relationen kontrollieren
    Dim Relation As DAO.Relation
    For Each Relation In Db.Relations
        If Relation.Table = PrimaryTable Then
            ' Beziehung gefunden
            ' Fremdschlüssel der Foreign Table durch den neuen Wert ersetzen
            Debug.Print Relation.Table, Relation.ForeignTable, Relation.Fields( _
              0).Name, Relation.Fields(0).ForeignName
            Db.Execute "update " & Relation.ForeignTable _
                & " set " & Relation.Fields(0).ForeignName & " = " & _
                ReplacementKey _
                & " WHERE " & Relation.Fields(0).ForeignName & " = " & _
                ExpiredKey
        End If
    Next Relation
    Exit Sub
Hell:
    Select Case Err.Number
    Case Else
        MsgBox "Unerwarteter Fehler: " & Err.Number & vbCrLf & Err.Description, _
          vbOKOnly + vbInformation,"Problem..."
    End Select
End Sub