الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

كيف نعمل استيراد للعلاقات فى الجداول

بدأه dr_ghost في 14 يونيو 2017 · 0 رد · 286 مشاهدة · في قواعد بيانات Microsoft Access
مشاركة: واتساب X فيسبوك تيليجرام
#1

حاولت بشتى الطرق ولكن للأسف يتم الاستيراد بدون علاقات علما بأن البك اب به علاقات وحاولت ايضا استخدام الكود الاتى :

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

مواضيع مشابهة