تغيير رابط جدول

الأخ ابو عاصم

هذه دالة مرر لها اسم القاعدة التي ترغب في ربط الجداول بها وكذلك مرر لها المسار والأخير اختياري يعني إذا لم تمرره سيتم استخدام مسار القاعدة التي تشغل الكود منها :

Public Function ربط_جداول(DbName As String, Optional DbPath As String)
    Dim objCat As New ADOX.Catalog
    Dim objTbl As ADOX.Table
    Dim strFullName As String

    objCat.ActiveConnection = CurrentProject.Connection

    For Each objTbl In objCat.Tables
        If objTbl.Type = "LINK" Then
                If DbPath = "" Then
                 ' إذا كان المسار فارغا سوف يستخدم مسار القاعدة الحالية
                 DbPath = CurrentProject.Path & ""
                 strFullName = DbPath & DbName
                 Else
                 strFullName = DbPath & "" & DbName
                 End If
        objTbl.Properties("Jet OLEDB:Link Datasource") = strFullName
        End If
    Next

    MsgBox "تم إعادة الربط بنجاح"
End Function

ولك تحياتي

نسيت أن أقول استخدم مرحع لـ ADO المسمى :

Micosoft ADO Ext .2.5 for DDL And Security

ولك تحياتي

حقاً إنك لرجل مبدع

أخي أبا حمود...

حقاً لقد نفست عني كربة في الأكسس

وقد حللت لي (قضية ولا أبا حسن لها)

كود رائع وجميل له فوائدة الكثيرة

والكود بعد التعديل ووضع مربع نص يسمى dbname ويسجل فيه اسم القاعدة مع امتدادها.

Private Sub أمر3_Click()

On Error GoTo Err_أمر3_Click

Dim objCat As New ADOX.Catalog

Dim objTbl As ADOX.Table

Dim strFullName As String

objCat.ActiveConnection = CurrentProject.Connection

For Each objTbl In objCat.Tables

If objTbl.Type = "LINK" Then

If DbPath = "" Then

' إذا كان المسار فارغا سوف يستخدم مسار القاعدة الحالية

DbPath = CurrentProject.Path & ""

strFullName = DbPath & dbname

Else

strFullName = DbPath & "" & dbname

End If

objTbl.Properties("Jet OLEDB:Link Datasource") = strFullName

End If

Next

MsgBox "تم إعادة الربط بنجاح"

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = ChrW(1606) & ChrW(1605) & ChrW(1608) & ChrW(1584) & ChrW(1580) & ChrW(49)

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_أمر3_Click:

Exit Sub

Err_أمر3_Click:

MsgBox Err.Description

Resume Exit_أمر3_Click

End Sub

اخي ابو حمود

اشكرك جدا على اهتمامك

ولكن الكود لم يعمل معي .

حيث قمت باضافة وحدة نمطية جديدة واضافة مرجع ado وقمت بنسخ الكود كما هو ولصقة في الوحدة النمطية الجديدة ووضعت اسم قاعدة البيانات التي عندي مكان dbname (التي لونها احمر ) .

وعندما عدت الى تشغيل البرنامج حيث وضعت نموذج يعمل في بداية التشغيل وعليه comb .

لم يحدث شيء جديد وكاني لم اعمل شيء .

ناسف جدا على كثرة الاستفسارات .

ولكم تحياتي .

الأخ علي

أولا أفضل أن تضع الكود في نفس النموذج الذي يظهر في بداية التشغيل إلا إذا كنت تستخدم الكود في أكثر من نموذج فضعه في الوحدة النمطية العامة .

في حدث بعد التحديث للقائمة وفي الوحدة النمطية للنموذج ضع :

Select case [اسم القائمة]
case "الجهات الحكومية"
ربط_جداول "a.mdb"
case "الشركات"
ربط_جداول "b.mdb"
case "أخرى"
ربط_جداول "d.mdb"
End select

قد يكون الكود غير منطبق لما عندك فغير الأسماء ، مثلا قد تكون الشركات هي قاعدة b أو d فغير مايلزم ، أيضا قد تكون القيمة التي كتبتها في القائمة ليست مثل ما كتبت ، مثل الشركات قد تكون كتبتها قاعدة الشركات فغير في الكود حسب مالديك وإذا لم يضبط معك فاكتب أسماء القواعد والجهة الخاصة بها وكذلك البيانات الموجودة في القائمة .

ولك تحياتي

اخي الكريم

القاعدة الاولى اسمها mard ( الشركات ) والثانية mbrd (تخص الجهات الحكومية ) والثالثة mdrd (وتخص الجهات الاخرى )

عملت جدول aa لهم به يحوي الحقل الاولى على اسم الشركة والحقل الثاني على رومزها بمعنى الشركات a وهكذا

قمت باضافة نموذج جديد وعليه قائمة اسمه s1 وفي مصدر الصف للقائمة عملت استعلام يحتوي جدول aa الذي به اسماء الشركات ورمزها .

ووضعت على النموذج زر امر يفتح النموج الذي المعلومات .

لكن عند تحديد جهة معينة من القائمة لاتظهر البيانات حسب التحديد .

شاكرين ومقدرين مجهودكم .

الأخ علي الموضوع لايحتاج إلى إنشاء جدول فقط أعمل التالي :

1- أنشئ قائمة منسدلة جديدة واجعل نوع مصدر الصف لها قائمة القيم

2- في مصدر الصف اكتب (أنسخ التالي وألصقه) :

الشركات;الجهات الحكومية;الجهات الأخرى

3- في حدث بعد التحديث للقائمة ضع الكود التالي :

Select Case s1
Case "الشركات"
ربط_جداول "mard.mdb"
Case "الجهات الحكومية"
ربط_جداول "mbrd.mdb"
Case "الجهات الأخرى"
ربط_جداول "mdrd.mdb"
End Select
Me.Requery

طبق هذا الكلام حرفيا وسيعمل بإذن الله .

ولك تحياتي

اخي ابو حمود /

لم يتغير عندي شيء واتصور المشكلة عندي في الكود حيث قمت بنسخة ولصقه في الوحدة النمطية . دون تغير لاني لم اعرف اين يمكن ان اضع التغير . المشكلة هنا

Public Function ربط_جداول(DbName As String, Optional DbPath As String)

Dim objCat As New ADOX.Catalog

Dim objTbl As ADOX.Table

Dim strFullName As String

objCat.ActiveConnection = CurrentProject.Connection

For Each objTbl In objCat.Tables

If objTbl.Type = "LINK" Then

If DbPath = "" Then

' إذا كان المسار فارغا سوف يستخدم مسار القاعدة الحالية

DbPath = CurrentProject.Path & ""

strFullName = DbPath & DbName

Else

strFullName = DbPath & "" & DbName

End If

objTbl.Properties("Jet OLEDB:Link Datasource") = strFullName

End If

Next

MsgBox "تم إعادة الربط بنجاح"

End Function

واشكرك كثيرا من اعماق قلبي ، وانت الان مخير اذا حبيت التعديل او نترك هذا الموضوع الى وقت اخر . ولك تحياتي

--------------------------------------------------------------------------------

ما رأيك أن ترسل لي الملف الذي يحتوي على هذا الكود لأرى سبب المشكلة .

ولك تحياتي