اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

هذا أنا.. 

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

LINK_TABLE.zip

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

link - m.salama.rar

تم تعديل بواسطه محمد سلامة
تصحيح أخطاء أملائية
  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

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

link - m.salama.rar

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

افتح وحدة نمطية جديدة وقم بتسميتها 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

  • Like 1
رابط هذا التعليق
شارك

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

رابط هذا التعليق
شارك

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

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

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

  • Like 1
رابط هذا التعليق
شارك

اخي الكريم 

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

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

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

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

bm.PNG

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

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

رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

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

Call MsgBox("ãä ÝÖáß ÇáÈÑäÇãÌ ÛíÑ ãÊÕá ÈÞÇÚÏÉ ÇáÈíÇäÇÊ ÇáÑÆíÓíÉÇáãÓãì (ÇßÊÈ ÇÓã ÇáÞÇÚÏÉ ÇáÎáÝíÉ åäÇ ÜÜ ÞÇÚÏÉ ÇáÌÏÇæá)
  • Like 1
رابط هذا التعليق
شارك

السلام عليكم  

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

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

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

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

 

  • Like 2
رابط هذا التعليق
شارك

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

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

Desktop.rar

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information