حاولت بشتى الطرق ولكن للأسف يتم الاستيراد بدون علاقات علما بأن البك اب به علاقات وحاولت ايضا استخدام الكود الاتى :
Function ImportRelations(DbName As String) As Integer
'------------------------------------------------------------------
' PURPOSE: Imports relationships where table names and field names
' match.
' ACCEPTS: The name of the external database as a string.
' RETURNS: The number of relationships imported as an integer.
'------------------------------------------------------------------
Dim ThisDb As DAO.Database, ThatDB As DAO.Database
Dim ThisRel As DAO.Relation, ThatRel As DAO.Relation
Dim ThisField As DAO.Field, ThatField As DAO.Field
Dim Cr As String, i As Integer, cnt As Integer, RCount As Integer
Dim j As Integer
Dim ErrBadField As Integer
Cr$ = Chr$(13)
RCount = 0
Set ThisDb = CurrentDb()
Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName$)
' Loop through all existing relationships in the external database.
For i = 0 To ThatDB.Relations.Count - 1
Set ThatRel = ThatDB.Relations(i)
' Create 'ThisRel' using values from 'ThatRel'.
Set ThisRel = ThisDb.CreateRelation(ThatRel.Name, _
ThatRel.table, ThatRel.foreigntable, ThatRel.Attributes)
' Set bad field flag to false.
ErrBadField = False
' Loop through all fields in that relation.
For j = 0 To ThatRel.Fields.Count - 1
Set ThatField = ThatRel.Fields(j)
' Create 'ThisField' using values from 'ThatField'.
Set ThisField = ThisRel.CreateField(ThatField.Name)
ThisField.foreignname = ThatField.foreignname
' Check for bad fields.
On Error Resume Next
ThisRel.Fields.Append ThisField
If Err <> False Then ErrBadField = True
On Error GoTo 0
Next j
' If any field of this relationship caused an error,
' do not add this relationship.
If ErrBadField = True Then
' Something went wrong with the fields.
' Do not do anything.
Else
' Try to append the relation.
On Error Resume Next
ThisDb.Relations.Append ThisRel
If Err <> False Then
' Something went wrong with the relationship.
' Skip it.
Else
' Keep count of successful imports.
RCount = RCount + 1
End If
On Error GoTo 0
End If
Next i
' Close databases.
ThisDb.Close
ThatDB.Close
' Return number of successful imports.
ImportRelations = RCount
End Function
TransferAllTables22_2.zip
