ربط القاعدة بقاعدة الجداول تلقائيا

موضوع منقول من المنتدي القديم

الكاتب : أبو حمود

ربط القاعدة بقاعدة الجداول تلقائيا

كثيرا ما نواجهة مشكلة إعادة ربط القاعدة التي توجد فيها الجداول بالقاعدة الأساسية (الواجهة) خاصة أننا كلمنا عدلنا في القاعدة لزمنا أن نعيد الربط عند المستخدم وتزيد المشكلة تعقيداً إذا تم إلغاء ظهور القوائم .

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

في ماكرو Autoexec اختر في الإجراء RunCode

وتحت في اسم الدالة اكتب ChkTabLink ()

ويفضل بشدة أن يكون هو أول أجراء في القاعدة حتى لايتم فتح أي نموذج قبل إعادة الربط .

وفي الوحدة النمطية العامة اكتب :

Dim tabCont As String

Public Function ChkTabLink()
Dim DBNameLinkNow As String
Dim DBFullPath As String

If IsTbleLinkDB = False Then
DBNameLinkNow = Right(tabCont, InStr(StrReverse(tabCont), "") - 1)
DBFullPath = Left(CurrentDb.Name, Len(CurrentDb.Name) - InStr(StrReverse(CurrentDb.Name), "") + 1)
Call LinkTable(DBFullPath & DBNameLinkNow)
End If
End Function


Public Sub LinkTable(DBName As String)
   On Error GoTo Err_LinkTable
    Dim db As Database
    Dim tdf As TableDef
    Dim obj As AccessObject, dbs As Object

    Set db = CurrentDb

    Set dbs = Application.CurrentData
    For Each obj In dbs.AllTables
          If Left(obj.Name, 4) <> "msys" Then ' لمنع الجداول النظامية
          Set tdf = db.TableDefs(obj.Name)
                If tdf.Attributes <> 0 Then ' لمنع الجداول غير المرتبطة
                tdf.Connect = ";DATABASE=" & DBName
                tdf.RefreshLink
                End If
          End If
    Next obj
Err_LinkTable:
MsgBox "إما أن الملف المرتبط به غير موجود أو تم تغيير اسمه ."
End Sub

Private Function IsTbleLinkDB() As Boolean
   On Error GoTo err_fix

Dim db As Database
Dim tdf As TableDef
Dim obj As AccessObject, dbs As Object

    Set db = CurrentDb
    Set dbs = Application.CurrentData
    For Each obj In dbs.AllTables
          If Left(obj.Name, 4) <> "msys" Then ' لمنع الجداول النظامية
          Set tdf = db.TableDefs(obj.Name)
          If tdf.Attributes <> 0 Then ' لمنع الجداول غير المرتبطة
          IsTbleLinkDB = True
          tabCont = tdf.Connect
          tdf.RefreshLink
          Exit For
          End If
          End If
    Next obj

err_fix:
If Err.Number = 3024 Then IsTbleLinkDB = False
End Function


 [code]

والكود يحتاج مرجع DAO .

من لديه فكرة لتطوير الطريقة فليتفضل بها لزيادة الاستفادة من الكود .

وللجميع التحية




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

http://www.arabteam2000.com/forum/Details.asp?id=11572



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

الكاتب: محمد طاهر بتاريخ: 9/30/2002 4:01:10 AM 


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

مثال آخر 


[code]
Sub RefreshLinkX()
  Dim dbsCurrent As Database
  Dim dbsLinked As Database
  Dim tdfLinked As TableDef

  Set dbsCurrent = OpenDatabase(CurrentDb.Name)

  With dbsCurrent
    For Each tdfLinked In .TableDefs
      Debug.Print tdfLinked.Connect
      If Nz(tdfLinked.Connect) <> "" Then
        tdfLinked.Connect = "MS Access;PWD=;DATABASE=C:DatabaseName"
        tdfLinked.RefreshLink
      End If
    Next
  End With

  dbsCurrent.Close
  Set dbsCurrent = Nothing
End Sub
[Code/]





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

abbashmd@hotmail.com 


الكاتب: أبو هادي بتاريخ: 9/30/2002 7:59:40 AM 







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






الأخ محمد

سأحمل المثال واخبرك

 فضلا انظر بريدك .



الأخ ابوهادي

الدالة التي استخدمتها شبيه جداً بهذه بل الاسم هو نفسه 

الدالة في الأعلى قمت بالتعديل عليها لأن رقم الخطأ في الدالة الأخيرة ليس هو نفسه في كل النسخ مع أن النسختين هما اكس بي ولكن في جهازين مختلفين ولا ادري ما السبب ؟!




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

تابع أخبار الانتفاضة - البرهان -الحوار الاسلامي المسيحي احصل على بريد اسلامي مجاني (20) ميجا - اعلانات اسلامية [UR 


الكاتب: ابوحمود بتاريخ: 9/30/2002 10:11:57 AM 







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






لم استطع تحرير الكود فأعدتها هنا :



[code]

Dim tabCont As String

Public Function ChkTabLink()
Dim DBNameLinkNow As String
Dim DBFullPath As String

If IsTbleLinkDB = False Then
DBNameLinkNow = Right(tabCont, InStr(StrReverse(tabCont), "") - 1)
DBFullPath = Left(CurrentDb.Name, Len(CurrentDb.Name) - InStr(StrReverse(CurrentDb.Name), "") + 1)
Call LinkTable(DBFullPath & DBNameLinkNow)
End If
End Function


Public Sub LinkTable(DBName As String)
   On Error GoTo Err_LinkTable
    Dim db As Database
    Dim tdf As TableDef
    Dim obj As AccessObject, dbs As Object

    Set db = CurrentDb

    Set dbs = Application.CurrentData
    For Each obj In dbs.AllTables
          If Left(obj.Name, 4) <> "msys" Then ' لمنع الجداول النظامية
          Set tdf = db.TableDefs(obj.Name)
                If tdf.Attributes <> 0 Then ' لمنع الجداول غير المرتبطة
                tdf.Connect = ";DATABASE=" & DBName
                tdf.RefreshLink
                End If
          End If
    Next obj
exit_err:
Exit Sub
Err_LinkTable:
MsgBox "إما أن الملف المرتبط به غير موجود أو تم تغيير اسمه ."
Resume exit_err

End Sub

Private Function IsTbleLinkDB() As Boolean
   On Error GoTo err_fix

Dim db As Database
Dim tdf As TableDef
Dim obj As AccessObject, dbs As Object

    Set db = CurrentDb
    Set dbs = Application.CurrentData
    For Each obj In dbs.AllTables
          If Left(obj.Name, 4) <> "msys" Then ' لمنع الجداول النظامية
          Set tdf = db.TableDefs(obj.Name)
          If tdf.Attributes <> 0 Then ' لمنع الجداول غير المرتبطة
          IsTbleLinkDB = True
          tabCont = tdf.Connect
          tdf.RefreshLink
          Exit For
          End If
          End If
    Next obj

exit_err:
Exit Function
err_fix:
If Err.Number = 3024 Or Err.Number = 3044 Then
IsTbleLinkDB = False
Else
MsgBox Err.Description
End If
Resume exit_err

End Function

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

الكاتب: ابوحمود بتاريخ: 9/30/2002 10:17:46 AM

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

الأخ محمد طاهر

وفقك الله لكل خير

اطلعت على المثال وهو جيد جداً ولكن يحتاج إلى بعض التطوير فمثلا :

نموذج ربط الجداول :

الأيمكن الاستغناء في طريقة الربط عن كتابة أسماء الجداول المطلوب الربط بها فما رأيك في مربع قائمة متعدد التحديد تظهر لنا فيه أسماء كل الجداول الموجودة في القاعدة المطلوب الاستيراد منها ثم المستخدم ينقر على ما يشاء منها .

في نموذج النسخ :

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

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

في مسار النسخة الاحتياطية استخدمت مربع حوار لإختيار ملف والصحيح أن يكون مربع الحوار لاختيار مسار إلى مجلد دون الملف وبعد الاختيار يتم حساب تاريخ اليوم مع المسار :

Day(date)

Month(date)

Year(date)

ثم ".mdb"

أما التصدير للأكسل فأنا ابغض الأكسل

والمثال ارى انه ينبغي التركيز فيه على كيف يستفيد المستخدم من الأكواد بأبسط أسلوب وبأقل قدر من التعديل على الكود .

وفقك الله وأعانك

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

الكاتب: ابوحمود بتاريخ: 9/30/2002 11:21:27 AM

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

جديدك قديمي

الأخ أبوحمود .. بعد التحية :

صدقني إن أحببت أن هذا الكود ليس بجديدي وقد استقطعته من أحد برامجي ولكني تذكرته عندما طرحت الموضوع وأحببت أن أضيفه كمساهمة .

وقد شدني قولك بتشابه نفس الدالة وحالت العثور على التشابه ولم أراه فإذا كنت تقصد الدوال الـ Built-in لا أعرف ما تسمى بالعربي فلا فخر لي ولك فيها ، اللهم هي كيفية توظيف هذه الدوال وستكون بالتأكيد نفس إسم الدالة عندك وعندي وعند كل المستخدمين .

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

وكل الطرق تؤدي إلى روما .

وما نستغني يا أبا حمود .

تحياتي

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

abbashmd@hotmail.com

الكاتب: أبو هادي بتاريخ: 9/30/2002 11:23:27 AM

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

الأخ ابوهادي

وفقك الله لكل خير وزادك علما

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

بالنسبة لكتابة الكود في رأيي ان تكتب إما في وحدة نمطية ثم تقوم بنسخة وهذا أفضل أو تكتب بعد إدراج إطار الكود وهذا أصعب قليلاً ثم اضغط زر C في اليسار سيظهر لك إطار انقر داخله مرتين متتاليتين ثم لصق أو اكتب ما تشاء ثم إذا انتهيت انقر على الإطار مرة واحدة ثم اضغط End ثم Enter لبدء سطر جديد سيبدأ في المنتصف أعدها بأوامر المحاذاة في الأعلى .

ويسر الله أمرك وشرح صدرك

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

الكاتب: ابوحمود بتاريخ: 9/30/2002 7:38:17 PM

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

تعقيب

ولا يهمك أبوحمود

الحقيقة أن هذه الدالة موجودة في الـ Help وأنا دائما ما أستعين بهذا الملف بالبحث وكثير من الأحيان أصل إلى أمور لا أتوقع أن أصل إليها أو قد تحل مشكلة سابقة عانيت منها ثم بالمصادفة أراها أمامي . وقد أقضي أحيانا الساعة أو تزيد للوصول إلى معلومة واحدة .

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

If then

If then

If then

msgbox "شكرا جزيلا"

end if

end if

end if

طول هذه الفترة لم ألاحظ وجود هذه الميزة !

تحياتي

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

abbashmd@hotmail.com

الكاتب: أبو هادي بتاريخ: 10/1/2002 9:34:04 AM

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

الملاحظات

أخي ابوحمود بالنسبة للملحوظات

نموذج ربط الجداول :

الأيمكن الاستغناء في طريقة الربط عن كتابة أسماء الجداول المطلوب الربط بها فما رأيك في مربع قائمة متعدد التحديد تظهر لنا فيه أسماء كل الجداول الموجودة في القاعدة المطلوب الاستيراد منها ثم المستخدم ينقر على ما يشاء منها .

ما منعني عن ذلك أن فى الجدول أضع مسار الربط و لدي قواعد مرتبطة باكثر من قاعدة فالمسار مختلف من ملف لآخر ، فلا بد من جدول

أما ان كان المسار واحد فيمكن تطبيق ما قلته

في نموذج النسخ :

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

بالطبع الزر سيكون أوضح بصفة عامة ، و لن انا أحب موضوع النقر علي مربعات النص هو مفتاح للكثير من الخطوات فى برامجي

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

هي تعيد المسار الافتراضي للملفات و الذي يمكن تغييره من:

Tools

Option

General

Default Database Folder

C:My Documents

اعتقد انها ستكونهكذا فى النسخة العربية

أدوات

خيارات

عام

المسار الافتراضي لقاعدة البيانات

في مسار النسخة الاحتياطية استخدمت مربع حوار لإختيار ملف والصحيح أن يكون مربع الحوار لاختيار مسار إلى مجلد دون الملف وبعد الاختيار يتم حساب تاريخ اليوم مع المسار :

Day(date)

Month(date)

Year(date)

ثم ".mdb"

و كيف يمكن تعديل اسم الملف بعد الاختيار ؟

أما التصدير للأكسل فأنا ابغض الأكسل

و أنا أعشقه و أعشق البرمجة فيه

و أدعوا الله أن يتيح لي اكمال هذه السلسلة ( بعد الانتهاء مما تعلم ) باذن الله

http://www14.brinkster.com/mtarafa/VBExcel.htm

مع تحياتي

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

الكاتب: محمد طاهر بتاريخ: 10/1/2002 2:10:55 PM

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

الأخ محمد

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

إنا لله وإنا اليه راجعون

أحسن الله عزائي

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

بالنسبة لمربع النص ضع اذن تلميح أنه بالنقر على هذا المربع سيحدث كذا وكذا وكذلك ضع في حدث عند تحريك الماوس على مربع النص معلومات على شريط المعلومات تفيد أيضا نفس الشيء لزيادة التأكد من وصول هذه المعلومة إليه .

ومربع النص عموما طريقة جيدة جداً واستخدمها أنا كثيرا ولكن يعيب عليها إذا لم يعرف المستخدم وجود هذا الحدث في هذا المربع بل صارت أنني نسيت أنا وقد برمجت أحد القواعد لأني لم اضع شيء يذكر به حتى اخبرني مستخدم القاعدة .

بالنسبة لدالة CurDir() لقد وجدت لدي كلام عنها أنها تعيد مكان قاعدة البيانات المرتبطة بها الجداول في القاعدة الحالية وقد جربت ذلك وفعلا أظهرت لي مسار القاعدة المرتبطة بها ثم قمت بالارتباط بقاعدة بيانات في مكان آخر فأظهرت لي الدالة المسار الأخير ولا ادري ما نظام عملها .

وبالنسبة لاسم الملف فلم أفهم العبارة التي كتبتها ؟

واخيرا والناس فيما يعشقون مذاهب

واحيي فيك تقبلك لنقد برامجك ولو كان النقد خاطئاً

لك تحياتي

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

الكاتب: ابوحمود