كود الاتصال بقاعدة بيانات

[علي محمد الكعبي]

وينك يابوابرهيم

[أبو إبراهيم الغامدي]

هذا أنا.. 

إذا كنت مقتنع بهذه الفكرة فإليك المرفق

LINK_TABLE.zip

[علي محمد الكعبي]

الان, أبو إبراهيم الغامدي said:

هذا أنا.. 

إذا كنت مقتنع بهذه الفكرة فإليك المرفق

LINK_TABLE.zip

مشكور وماقصرت واتعبتك معي وجاري البحث في الموضوع لتعمق فيه اكثر 

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

بس ممكن توضح لي ماهو معنى تلك الرساله التي تظهر 

[محمد سلامة]

السلام عليكم ورحمة الله وبركاته

لو تسمحوا لى بالمشاركة معكم فى هذا الموضوع 

يوجد اكثر من طريقة لهذا الموضوع

ولكنى اكثر طريقة عجبتنى واستخدمها فى جميع برامجى للعملاء هى طريقة خاصة باستاذنا ومعلمنا ابوخليل بارك الله فيه

ميزة هذه الطريقة هى انك تستطيع عمل كلمة مرور لقاعدة البياناتالخلفية (قاعدة الجداول) وتمرير كلمة السر من قاعدة الوجهات

واليك الطريقة فى المثال التالى

كلمة السر لقاعدة البيانات الخلفية admin

وبعد تحميل ال بروجرس بار سيتاكد من الاتصال بالقاعدة ويظهر لك الشاشة الرئيسية (يمكنك تغييرها باى نموذج تريده)

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

link - m.salama.rar

تم تعديل يناير 10, 2017 بواسطه محمد سلامة
تصحيح أخطاء أملائية

[علي محمد الكعبي]

3 دقائق مضت, محمد سلامة said:

السلام عليكم ورحمة الله وبركاته

لو تسمحوا لى بالمشاركة معكم فى هذا الموضوع 

يوجد اكثر من طريقة لهذا الموضوع

ولكنى اكثر طريقة عجبتنى واستخدمها فى جميع برامجى للعملاء هى طريقة خاصة باستاذنا ومعلمنا ابوخليل بارك الله فيه

ميزة هذه الطريقة هى انك تستطيع عمل كلمة مرور لقاعدة البياناتالخلفية (قاعدة الجداول) وتمرير كلمة السر من قاعدة الوجهات

واليك الطريقة فى المثال التالى

كلمة السر لقاعدة البيانات الخلفية admin

وبعد تحميل ال بروجرس بار سيتاكد من الاتصال بالقاعدة ويظهر لك الشاشة الرئيسية (يمكنك تغييرها باى نموذج تريده)

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

link - m.salama.rar

اتشرف بمشاركتك استاذي 

ممكن تغيير المثال لاصادر 2003

انا عندي الاوفيس 2007 ولكن لايمكنني فتح الملف

[محمد سلامة]

عيونى .. ثوانى

غريبة مع ان كل المرفقات اللى فى المشاركة هنا باصدار اعلى من 2003

كيف كنت تطلع عليها ؟؟؟

وانا حملت المثال الاخير وعدلت عليه فقط

[علي محمد الكعبي]

[محمد سلامة]

ما اصدار الاكسس لديك

 

[علي محمد الكعبي]

2007

[محمد سلامة]

جرب كده .. وتحت امركlink - m.salama.rar

 

[علي محمد الكعبي]

12 دقائق مضت, محمد سلامة said:

جرب كده .. وتحت امركlink - m.salama.rar

 

مازلات المشكة كما في الصورة التي ارفقتها لك

[محمد سلامة]

طيب سيبك من المرفق 

افتح وحدة نمطية جديدة وقم بتسميتها modRelinker

وادرج بها هذا الكود 

Option Compare Database
Option Explicit
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, "SOFT SAMPLE -Pro.In.Out")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
      With fd
        .AllowMultiSelect = False
        .InitialFileName = CurrentDBFolder()
        .Filters.Add "Access Database File (*.accdb)", "*.accdb", 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

وفى النموذج الافتتاحى فى بداية البرنامج ضع الكود التالى

Private Sub Form_Close()
On Error Resume Next
If CheckLinks("admin") = 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)) '
DoCmd.OpenForm "LNK_TBL_DLG"
DoCmd.Close acForm, Me.Name
End Sub

وقم بعمل كلمة سر لقاعدة البيانات الخلفية باسم admin

[علي محمد الكعبي]

7 دقائق مضت, محمد سلامة said:

طيب سيبك من المرفق 

افتح وحدة نمطية جديدة وقم بتسميتها modRelinker

وادرج بها هذا الكود 

Option Compare Database
Option Explicit
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, "SOFT SAMPLE -Pro.In.Out")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
      With fd
        .AllowMultiSelect = False
        .InitialFileName = CurrentDBFolder()
        .Filters.Add "Access Database File (*.accdb)", "*.accdb", 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

وفى النموذج الافتتاحى فى بداية البرنامج ضع الكود التالى

Private Sub Form_Close()
On Error Resume Next
If CheckLinks("admin") = 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)) '
DoCmd.OpenForm "LNK_TBL_DLG"
DoCmd.Close acForm, Me.Name
End Sub

وقم بعمل كلمة سر لقاعدة البيانات الخلفية باسم admin

سويت مثل ماقلت ولكن كيف العمل

LINK_TABLE2.rar

[محمد سلامة]

اخى الكريم مرفقك الاخير يعمل بدون مشاكل وانت بنفسك ضايف الاكواد 

 

شغال نموذج start وهو سيرتبط تلقائياً

[علي محمد الكعبي]

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

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

وهل يمكن وضع نموذج يعمل على عملية الربط بقاعدة بيانات اخر

[علي محمد الكعبي]

وينك ياستاذ محمد سلامة

[محمد سلامة]

عفوا اخي انقطع التيار الكهربائي

واحدثك من الموبيل

نعم يعمل علي شبكة محلية وبدون مشاكل

[علي محمد الكعبي]

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

[محمد سلامة]

اخي الكريم 

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

هل يوجد شئ غير مفهوم

4 دقائق مضت, علي محمد الكعبي said:

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

هذا بسبب عدم اضافة مرجع

غدا نستكمل باذن الله

[علي محمد الكعبي]

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

انظر بنفسك وين الخطاء 

واعذرني ان ثقلت عليك ولكن احببت ان اتعلم منك بحيث اني اطمح منك المزيد في التعلم وبالتفاعل في موضيعي المطروحة

مجلد جديد ‫‬.rar

[علي محمد الكعبي]

تم اضافة المرجع 

ماهي الرسالة في هذا السطر استاذي 

Call MsgBox("ãä ÝÖáß ÇáÈÑäÇãÌ ÛíÑ ãÊÕá ÈÞÇÚÏÉ ÇáÈíÇäÇÊ ÇáÑÆíÓíÉÇáãÓãì (ÇßÊÈ ÇÓã ÇáÞÇÚÏÉ ÇáÎáÝíÉ åäÇ ÜÜ ÞÇÚÏÉ ÇáÌÏÇæá)

[علي محمد الكعبي]

وينك ياستاذ محمد

[ابوخليل]

السلام عليكم  

هذه تظهر دائما عند النسخ واللصق اذا كان فيه  حروف عربية  بين الاكواد

وهذه هي على الصورة الصحيحة 

 Call MsgBox("مطلوب قم بتحديده واختياره (BData.mdb) ملف البيانات", vbCritical)

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

 

[MOHAAPE-ATn]

في ٩‏/١‏/٢٠١٧ at 01:50, محمد ايمن said:

تفضل اخي الكريم

Desktop.rar

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

[ابو جودي]

هذا الموضوع قد تجدون فيه ان شاء الله ضالتكم