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

[ابوخليل]

وهي الطريقة التي استخدمها في اعمالي

وحدة نمطية وكود للربط داخل النموذج

 

انسخ الكود التالي والصقه في وحدة نمطية عامة

Public Function CheckLinks(ByVal strDBPassword As String) As Boolean
    On Error GoTo CheckLinksErr
     Dim tdf As TableDef
    Dim strNewMDB As String
    Dim fd As FileDialog
    For Each tdf In CurrentDb.TableDefs
    If UCase(Left(tdf.Name, 6)) <> "COMPAS" Then
    If Len(tdf.Connect) > 0 And tdf.Fields.Count = 0 Then
    If Len(strNewMDB) = 0 Then
       Call MsgBox("مطلوب قم بتحديده واختياره (اسم قاعدة الجداول لديك) ملف البيانات", vbCritical)
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
      With fd
        .AllowMultiSelect = False
        .InitialFileName = CurrentDBFolder()
        .Filters.ADD "Access Database File (*.mdb)", "*.mdb", 1
        .TITLE = "Select Back-End Data File"
        .ButtonName = "Link Tables"
    If .Show = False Then
              Exit Function
        Else
          strNewMDB = .SelectedItems(1)
             End If
                End With
            End If
   If (IsNull(strDBPassword) = True) Or (strDBPassword = "") Then
       tdf.Connect = ";DATABASE=" & strNewMDB
           Else
             tdf.Connect = ";DATABASE=" & strNewMDB & ";PWD=" & strDBPassword
           End If
              tdf.RefreshLink
        End If
    End If
    Next tdf
    CheckLinks = True
CheckLinksDone:
    Exit Function
CheckLinksErr:
    MsgBox "Error #" & err.Number & ": " & err.Description, vbCritical
    Resume CheckLinksDone
End Function


Public Function CurrentDBFolder() As String
    Dim strPath As String
    strPath = CurrentDb.Name
    Do While Right$(strPath, 1) <> "\"
        strPath = Left$(strPath, Len(strPath) - 1)
    Loop
    CurrentDBFolder = strPath
End Function

ثم الصق الكود التالي في حدث التحميل لنموذج البداية

On Error Resume Next
If CheckLinks("") = False Then
Call Quit
End If
Dim tdfs As DAO.TableDefs
    Dim tdf As TableDef
    Dim sSourceDB As String
    Dim sBackupDB As String
    Dim backDBName As String
    Set tdfs = CurrentDb.TableDefs
    Set tdf = tdfs(tdfs.Count - 1)
   sSourceDB = Right(tdf.Connect, Len(tdf.Connect) - 10)
   backDBName = Dir(Mid(tdf.Connect, 11))
   sBackupDB = Mid(tdf.Connect, 11, Len(tdf.Connect) - (Len(backDBName) + 10)) '

وفي المثال تطبيق للمقال

ملحوظة : اذا لم يعمل المثال على الوجه الأكمل انظر في المكتبات

link_be.rar

[عبدالرحمن هاشم]

جزاك الله خيرا أستاذنا الفاضل أبو خليل

 

أدام الله عليك نعمته وعلمه الذي لا تبخلون به علينا

[jjafferr]

شكرا استاذنا الفاضل أبوخليل 

 

كان في سؤال آخر عن نفس الموضوع ، كنت مشارك فيه هنا:

http://www.officena.net/ib/index.php?showtopic=60354

 

 

ولقد تركت فيه رابط هذا الموضع لتعم الفائدة 

 

 

جعفر

[محمد سلامة]

جميل جدا هذا المثال وهو بسيط

تسلم يدك استاذنا ابوخليل

 

 

 

جربت وعملت باسورد الى قاعدة بيانات الجداول فقط

ثم ذهبت حتى افتح قاعدة الواجهات وشغلت عادى واختارت قاعدة الجداول 

ظهر لى هذه الرسالة

erorr.rar

وبعد الضغط على اوكى في الرسالة تغلق القاعدة

برجاء الافادة

تم تعديل أبريل 6, 2015 بواسطه soft.sample

[رمهان]

الموضوع مخالف !!! مكرر !!! وهنا

http://www.officena.net/ib/index.php?showtopic=52500

 

كما انه يمكن ان يكون كمشاركة هنا ولترابط المواضيع

http://www.officena.net/ib/index.php?showtopic=60354

 

واسمحو لي بوجهة النظر هذي الشخصية : لماذا لا اربط من خلال الاكسس ! كلها كم دقيقة ! اذا لم تكن ثواني !

 

تحياتي

تم تعديل أبريل 7, 2015 بواسطه رمهان

[ابوخليل]

الموضوع مخالف !!! مكرر !!! وهنا

 

الله المستعان ، كلامك صحيح فشكرا لك على التنبيه ، ولعل في اختلاف العناوين فائدة

وازيدك من الشعر بيت :

ان الرابط السابق الكود مع الشرح فيكون افضل

والسبب بعدم وجود الشرح هنا انني سحبت الكود من برنامجي وقد ذكرت ذلك في اول المشاركة

 

كما انه يمكن ان يكون كمشاركة هنا ولترابط المواضيع

 

ما قصر اخونا جعفر مشكورا فقد وضع  الروابط  اللازمة بين الموضوعين

 

واسمحو لي بوجهة النظر هذي الشخصية : لماذا لا اربط من خلال الاكسس ! كلها كم دقيقة ! اذا لم تكن ثواني !

 

هذا اذا كان المبرمج  فقط  من سيتعامل مع البرنامج

وللعلم  وهو يحدث دائما (في الشبكات) فيما لو كانت قاعدة الجداول على الخادم 

فلو حدث خلل في الشبكة فلن يخبرك اكسس بالمشكلة

لذا يستحب اضافة عبارة تنبه الى احتمال ذلك داخل الرسالة الظاهرة

[محمد سلامة]

طيب وانا مش هتجاوب علي مشاركتي بعاليه

[ابوخليل]

طيب وانا مش هتجاوب علي مشاركتي بعاليه

 ههههه  .. ظريف ..

واعذرني   على هذه الغفلة  

 

والاجابة يسيرة  وهي ان تضع كلمة المرور الخاصة بقاعدة الجداول  داخل الكود

الكود موجود في محرر نموذج البداية

كالتالي :

If CheckLinks("ضع كلمة المرور هنا") = False Then
Call Quit
End If

[محمد سلامة]

ممتاز

تسلم يا استاذنا

فعلا هذه الطريقة سوف تريحني جدا مع العملاء

[yms12]

بارك الله فيك

[suadeng]

On 4/7/2015 at 11:58 AM, ابوخليل said:

ابة يسيرة  وهي ان تضع كلمة المرور الخاصة بقاعدة الجداول  داخل الكود

الكود موجود في محرر نموذج البداية

كالتالي :

لم يعمل معي الكود على نسخة  access 2007 حيث اللاحقة .accdb ما التعديل اللازم اضافته و شكرا

[ابوخليل]

لم اجرب على 2007  او اصدار اعلى  فلعل بعض الاخوة ممن جرب يفيدك في هذا 

ولكن يمكنك التجربة : ابحث في الكود عن   mdb  واستبدلها بــ   accdb

[محمد سلامة]

منذ ساعه, ابوخليل said:

لم اجرب على 2007  او اصدار اعلى  فلعل بعض الاخوة ممن جرب يفيدك في هذا 

ولكن يمكنك التجربة : ابحث في الكود عن   mdb  واستبدلها بــ   accdb

بارك الله فيك استاذنا ابوخليل

البرنامج يعمل معي علي 2010

[king5star]

في 10/11/2016 at 18:39, محمد سلامة said:

بارك الله فيك استاذنا ابوخليل

البرنامج يعمل معي علي 2010

اذا كان فى امكانية مشاركتنا تجربتك باضافة الكود والطريقة المستخدمة واكون لك شاكراً .

[sandanet]

تعددت الاسباب والربط واحد  جميل جدا جدا ماتفضلت به استاذنا الكبير أبو خليل

انا عن نفسي فاني استخدم هذه الطريقة المطولة بعض الشيء ..

link_database.zip

[sandanet]

في 10/11/2016 at 17:38, ابوخليل said:

لم اجرب على 2007  او اصدار اعلى  فلعل بعض الاخوة ممن جرب يفيدك في هذا 

ولكن يمكنك التجربة : ابحث في الكود عن   mdb  واستبدلها بــ   accdb

من بعد اذنك استاذي يمكن استبدال الامتداد mdb بـ accdb وسوف تظهر القاعدة لكن للأسف لايتم الربط معها الا اذا كانت قاعدة الواجهة هي ايضاً accdb او accde لذلك يجب انشاء ملف فارغ بصيغة accdb اولاً ومن ثم استيراد جميع كائنات ملف link.mdb مع التشديد على اختيار المكتبات نفسها 

 

تحياتي