مشكلة عند تغيير قاعدة بيانات اخرى تحمل نفس اسم قاعدة البيانات الاصلية

**sandanet** · فبراير 23, 2017

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

اساتذتي الكرام تحية طيبة ،،

في المثال المرفق برنامج مرتبط بقاعدة بيانات اسمها database1 لكن لو فرضنا ان العميل قام بتغيير تلك القاعدة بقاعدة اخرى لبرنامج آخر بالخطأ ظناً منه انها تابعة لبرنامجه هذا عندئذ سوف تظهر له رسائل اخطاء كثيرة عند فتحه للنماذج لانه بطبيعة الحال سوف لن يتم استيراد تلك الجداول المطلوبة ، السؤال هو كيف يتم حل هذه المشكلة؟

تحياتي

New folder.zip

**رمهان** · فبراير 24, 2017

اجابة مبدئية

يمكنك وضع كود يشيك على وجود الملف بنفس الاسم وليكن باستخدام الدالة dir ويكون في نموذج البدء. فان وجد الملف او التنبيه والخروج

ام تقصد ان اسم الملف بقي نفسه ولكن المحتوى من الجداول اصبح مختلف ؟

تحياتي

تم تعديل فبراير 24, 2017 بواسطه رمهان

**sandanet** · فبراير 24, 2017

نعم اخي رمهان اقصد " ان اسم الملف بقي نفسه ولكن المحتوى من الجداول اصبح مختلف" وقد وضعت مرفق فيه برنامج اسمه test مرتبط بقاعدة اسمها database1 وهناك قاعدة اخرى يمكنك تغيير اسمها باسم القاعدة database1 لكنها لاتحتوي على نفس الجداول

تحياتي

**jjafferr** · فبراير 24, 2017

السلام عليكم

ومشاركة مع اخي رمهان ، اليك الكود الذي يقارن جداول FE مع جداول BE قاعدة البيانات التي تم اختيارها ،

فاذا الجداول موجودة ، يخبرك بذلك ، ويربط الـ FE بالـ BE ،

وإلا ، فسيخبرك ولن يفعل شئ:

Option Compare Database

Private Sub Command0_Click()
On Error GoTo Err_Command0_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

'j    DoCmd.Close
'j    stDocName = "frm"
'j    DoCmd.OpenForm stDocName, , , stLinkCriteria

    BackFile = GetOpenFile()
    If Len(BackFile & "") = 0 Then Exit Sub

    Dim FrontObj As AccessObject, FrontDB As Object
    Dim BackObj As TableDef, BackDB As Database, PW As String, PWD As String
    Set FrontDB = Application.CurrentData

    'the Selected BE
    Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD)
    
    'Start with a table to look for
    For Each FrontObj In FrontDB.AllTables
        If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then
            FE = FrontObj.NAME
            
            'look for that table in BE
            For Each BackObj In BackDB.TableDefs
                If left(BackObj.NAME, 4) <> "MSys" Then
                    BE = BackObj.NAME
                    
                    If BackObj.NAME = FrontObj.NAME Then
                        Same = 0
                        GoTo Found_It
                    Else
                        Same = 1
                        
                    End If
                End If  'BackObj
            Next BackObj
            
        If Same = 1 Then GoTo Not_Same

Found_It:
        End If  'FrontObj
    Next FrontObj
            
'All Good
        MsgBox "All FE tables exist in BE"
           
        Set FrontDB = Nothing
        Set BackDB = Nothing
        
        'link the tables
        Call AutoLink
        
    Exit Sub
    
Not_Same:

'No Good
    MsgBox "The FE table : " & FrontObj.NAME & vbCrLf & _
           "Is Not in the BE"
    

    Set FrontDB = Nothing
    Set BackDB = Nothing




Exit_Command0_Click:
    Exit Sub

Err_Command0_Click:
    MsgBox Err.Description
    Resume Exit_Command0_Click
    
End Sub

وعملت تغيير بسيط في الوحدة النمطية التي تقوم بالربط :smile:

جعفر

605.test.mdb.zip

**sandanet** · فبراير 24, 2017

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

تحياتي

**رمهان** · فبراير 25, 2017

شكرا اخي العزيزي جعفر

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

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

تحياتي

**sandanet** · فبراير 25, 2017

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

ارجو من الاساتذة الاطلاع على المرفق

بالنسبة لاقتراحك استاذ رمهان فهو اقتراح جميل وباعتقادي انه يكفي ان نتحقق من وجود قيمة معينة في حقل ثابت القيم مثلاً "تأكد من وجود رقم 12 في حقل Months في جدول tblMonths " فالارقام هنا هي ارقام الاشهر وهي ثابتة وهذه برأيي كافية لهذا الغرض وانا هدفي من بداية الموضوع هو الوصول الى تلك النقطة

تحياتي

New folder.zip

تم تعديل فبراير 25, 2017 بواسطه sandanet

**jjafferr** · فبراير 25, 2017

21 ساعات مضت, sandanet said:

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

تحياتي

وعليكم السلام أخي أوس :smile:

تفضل ، وهذا كود الوحدة النمطية Utils بالكامل ، بعد حذف الكود من النموذج ، وإضافة الكود فيها ، مع عمل التغييرات المطلوبة لعمل الكود:

Option Compare Database
Option Explicit


Function AreLinkedDBs()

On Error GoTo MyErr

Dim IsThereDBs As Long
IsThereDBs = Nz(DCount("[DBID]", "BackDBs"), 0)

If IsThereDBs = 0 Then
DoCmd.OpenForm "LinkDBsMain"
Exit Function
End If

Dim NoDBSCount As Long

If IsThereDBs <> 0 Then
CodeDb.Execute "UPDATE BackDBs SET BackDBs.[Found] = IIf(CheckFile(BackDBs.[DBPathANDName])=1,True,False);"
NoDBSCount = Nz(DCount("[DBID]", "BackDBs", "[Found]=False"), 0)
If NoDBSCount = 0 Then DoCmd.OpenForm "Background" Else: DoCmd.OpenForm "LinkDBsMain"
Exit Function
End If

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

End Function
Function AutoLink()

On Error GoTo MyErr

' حذف الجداول المرتبطة الموجودة بقاعدة البيانات الامامية أي الحالية

Dim FrontObj As AccessObject, FrontDB As Object
Set FrontDB = Application.CurrentData

For Each FrontObj In FrontDB.AllTables
If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then
DoCmd.DeleteObject acTable, FrontObj.NAME
End If
Next FrontObj

' إعادة ربط الجداول مرة أخرى

Dim MinDBID As Long, MaxDBID As Long, i As Long
Dim BackObj As TableDef, BackDB As Database, BackFile As String, PW As String, PWD As String

MinDBID = Nz(DMin("[DBID]", "BackDBs"), 0)
MaxDBID = Nz(DMax("[DBID]", "BackDBs"), 0)

For i = MinDBID To MaxDBID
BackFile = Nz(DLookup("[DBPathANDName]", "BackDBs", "[DBID]=" & i), Null)
PW = Nz(DLookup("[MyPass]", "BackDBs", "[DBID]=" & i), "")
PWD = ";" & "PWD" & "=" & PW

Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD)

For Each BackObj In BackDB.TableDefs
If left(BackObj.NAME, 4) <> "MSys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", BackFile, acTable, BackObj.NAME, BackObj.NAME
End If
Next BackObj
Next i

Set FrontDB = Nothing
Set BackDB = Nothing

' هنا ، نكتب اسم النموذج الخاص بالشاشة الافتتاحية
' اذا لم تكن ترغب في ان يتم فتح نموذج ما ، بعد عملية ربط الجداول ، امسح السطر التالي
'j DoCmd.OpenForm "Background"
DoCmd.OpenForm "frm"

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

End Function
Function CheckFile(DBPath) As Integer

' هذه الدالة تقوم بالتأكد من وجود قاعدة البيانات الخلفية

On Error GoTo MyErr:
    
Open DBPath For Input As #1
Close
CheckFile = 1
Exit Function

MyErr:
Exit Function
    
End Function

Function Compare_FE_BE_Tables(BackFile)
On Error GoTo Err_Compare_FE_BE_Tables

    Dim stDocName As String
    Dim stLinkCriteria As String

'j    DoCmd.Close
'j    stDocName = "frm"
'j    DoCmd.OpenForm stDocName, , , stLinkCriteria

'    BackFile = GetOpenFile()
    If Len(BackFile & "") = 0 Then Exit Function

    Dim FrontObj As AccessObject, FrontDB As Object
    Dim BackObj As TableDef, BackDB As Database, PW As String, PWD As String
    Set FrontDB = Application.CurrentData

    'the Selected BE
    Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD)
    
    'Start with a table to look for
    For Each FrontObj In FrontDB.AllTables
        If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then
'           FE =  FrontObj.NAME
            
            'look for that table in BE
            For Each BackObj In BackDB.TableDefs
                If left(BackObj.NAME, 4) <> "MSys" Then
'                    BE = BackObj.NAME
                    
                    If BackObj.NAME = FrontObj.NAME Then
                        Compare_FE_BE_Tables = 0
                        GoTo Found_It
                    Else
                        Compare_FE_BE_Tables = 1
                        
                    End If
                End If  'BackObj
            Next BackObj
            
        If Compare_FE_BE_Tables = 1 Then GoTo Not_Same

Found_It:
        End If  'FrontObj
    Next FrontObj
            
'All Good
        MsgBox "All FE tables exist in BE"
           
        Set FrontDB = Nothing
        Set BackDB = Nothing
        
        'update the field in the table
        'DoCmd.SetWarnings False
        '    DoCmd.RunSQL ("UPDATE BackDBs SET DBPathANDName = " & BackFile & " WHERE DBID = 3")
        'DoCmd.SetWarnings True
       
        'link the tables
        'Call AutoLink
        
    Exit Function
    
Not_Same:

'No Good
    MsgBox "The FE table : " & FrontObj.NAME & vbCrLf & _
           "Is Not in the BE"
    

    Set FrontDB = Nothing
    Set BackDB = Nothing




Exit_Compare_FE_BE_Tables:
    Exit Function

Err_Compare_FE_BE_Tables:
    MsgBox Err.Description
    Resume Exit_Compare_FE_BE_Tables

End Function

وطريقة العمل:

عملت ماكرو بإسم AutoExec (اي انه اول شئ سوف يشتغل لما يفتح البرنامج) ، وفيه طلبت منه الذهاب الى Function AreLinkedDBs ،

وطبعا حذفت النموذج Background من ان يفتح عند فتح البرنامج :smile:

4 ساعات مضت, رمهان said:

شكرا اخي العزيزي جعفر

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

ها ، ما اسمع ، رجاء ترفع صوتك شوي اخوي رمهان علشان اسمعك عدل :wink2:

اخاف بعد ان نقوم بهذه العملية ، تطلع لنا وتطلب مقارنة اعدادات كل حقل :wink2:

جعفر

605.1.test.mdb.zip

**رمهان** · فبراير 25, 2017

5 دقائق مضت, jjafferr said:

ها ، ما اسمع ، رجاء ترفع صوتك شوي اخوي رمهان علشان اسمعك عدل

1 ساعه مضت, sandanet said:

بالنسبة لاقتراحك استاذ رمهان فهو اقتراح جميل وباعتقادي انه يكفي ان نتحقق من وجود قيمة معينة في حقل ثابت القيم مثلاً "تأكد من وجود رقم 12 في حقل Months في جدول tblMonths " فالارقام هنا هي ارقام الاشهر وهي ثابتة وهذه برأيي كافية لهذا الغرض وانا هدفي من بداية الموضوع هو الوصول الى تلك النقطة

New folder.zip

10 دقائق مضت, jjafferr said:

اخاف بعد ان نقوم بهذه العملية ، تطلع لنا وتطلب مقارنة اعدادات كل حقل

جعفر

605.1.test.mdb.zip

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

بس اللي مش ممكن ان جعفر يخاف :wavetowel:

تحياتي

**jjafferr** · فبراير 25, 2017

32 دقائق مضت, رمهان said:

ممكن استاذ جعفر حسب فكرتك

2 ساعات مضت, sandanet said:

بالنسبة لاقتراحك استاذ رمهان فهو اقتراح جميل وباعتقادي انه يكفي ان نتحقق من وجود قيمة معينة في حقل ثابت القيم مثلاً "تأكد من وجود رقم 12 في حقل Months في جدول tblMonths " فالارقام هنا هي ارقام الاشهر وهي ثابتة وهذه برأيي كافية لهذا الغرض وانا هدفي من بداية الموضوع هو الوصول الى تلك النقطة

غالي والطلب رخيص :smile:

وهذا المرفق بعد ان يتأكد من وجود الجدول tblMonths ، يتأكد من وجود الشهر 12 ، بهذه الاضافة الى الكود:

            'look for that table in BE
            For Each BackObj In BackDB.TableDefs
                If left(BackObj.NAME, 4) <> "MSys" Then
'                    BE = BackObj.NAME
                    
                    If BackObj.NAME = FrontObj.NAME Then
                        
                        
                        
                        'check if tblmonths contain the value 12 in Month_No
                        If BackObj.NAME = "tblMonths" Then
                            Dim dbsNew  As Database
                            Dim rst_TQ As DAO.Recordset
                            Dim msg As Integer
                            
                            Set dbsNew = OpenDatabase(BackFile)
                            Set rst_TQ = dbsNew.OpenRecordset("SELECT * FROM tblMonths IN '" & BackFile & "'")
                            
                            rst_TQ.FindFirst "[Month_No]=12"
                            If rst_TQ.NoMatch Then
                                'MsgBox "Didn't find 12"
                                msg = 1
                                Compare_FE_BE_Tables = 1
                            Else
                                'MsgBox "OK"
                                Compare_FE_BE_Tables = 0
                                GoTo Found_It
                            End If
                            
                            rst_TQ.Close: Set rst_TQ = Nothing: Set dbsNew = Nothing
                        Else
                            Compare_FE_BE_Tables = 0
                            GoTo Found_It
                        End If
                         
                         
                         
'                        Compare_FE_BE_Tables = 0
'                        GoTo Found_It
                    Else
                        Compare_FE_BE_Tables = 1
                        
                    End If
                End If  'BackObj
            Next BackObj

جعفر

605.2.test.mdb.zip

**sandanet** · فبراير 25, 2017

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

تحياتي

**jjafferr** · فبراير 26, 2017

9 ساعات مضت, sandanet said:

فعند الربط بصورة صحيحة اول مرة قم بتغيير اسم قاعدة البيانات database1 وضع القاعدة الاخرى التي لاتحتوي على الجداول باسم database1

المفروض تظهر رسالة تفيد بان القاعدة تم تغييرها وان القاعدة الحالية ليست صالحة لهذا البرنامج

هذا طلب غريب !!

واشوف شو اللي اقدر عليه ان شاء الله :smile:

جعفر

**sandanet** · فبراير 26, 2017

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

ارجو ان تكون فكرتي واضحة :Rules:

تحياتي :biggrin:

**jjafferr** · فبراير 26, 2017

السلام عليكم :smile:

هذه النسخة:

ستفحص الجداول الخلفية في BE ، واذا كانت تختلف من عن جداول برنامج الواجهة FE (اذا اي من الجداول غير موجود ، او قيمة الرقم 12 غير موجود في جدول tblMonths) ، فسيخبرك بذلك ، وهذا هو الكود حاليا:

Option Compare Database
Option Explicit


Function AreLinkedDBs()

On Error GoTo MyErr

Dim IsThereDBs As Long
IsThereDBs = Nz(DCount("[DBID]", "BackDBs"), 0)

If IsThereDBs = 0 Then
DoCmd.OpenForm "LinkDBsMain"
Exit Function
End If

Dim NoDBSCount As Long

If IsThereDBs <> 0 Then
CodeDb.Execute "UPDATE BackDBs SET BackDBs.[Found] = IIf(CheckFile(BackDBs.[DBPathANDName])=1,True,False);"
NoDBSCount = Nz(DCount("[DBID]", "BackDBs", "[Found]=False"), 0)
If NoDBSCount = 0 Then DoCmd.OpenForm "Background" Else: DoCmd.OpenForm "LinkDBsMain"
Exit Function
End If

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

End Function
Function AutoLink()

On Error GoTo MyErr

' حذف الجداول المرتبطة الموجودة بقاعدة البيانات الامامية أي الحالية

Dim FrontObj As AccessObject, FrontDB As Object
Set FrontDB = Application.CurrentData

For Each FrontObj In FrontDB.AllTables
If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then
DoCmd.DeleteObject acTable, FrontObj.NAME
End If
Next FrontObj

' إعادة ربط الجداول مرة أخرى

Dim MinDBID As Long, MaxDBID As Long, i As Long
Dim BackObj As TableDef, BackDB As Database, BackFile As String, PW As String, PWD As String

MinDBID = Nz(DMin("[DBID]", "BackDBs"), 0)
MaxDBID = Nz(DMax("[DBID]", "BackDBs"), 0)

For i = MinDBID To MaxDBID
BackFile = Nz(DLookup("[DBPathANDName]", "BackDBs", "[DBID]=" & i), Null)
PW = Nz(DLookup("[MyPass]", "BackDBs", "[DBID]=" & i), "")
PWD = ";" & "PWD" & "=" & PW

Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD)

For Each BackObj In BackDB.TableDefs
If left(BackObj.NAME, 4) <> "MSys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", BackFile, acTable, BackObj.NAME, BackObj.NAME
End If
Next BackObj
Next i

Set FrontDB = Nothing
Set BackDB = Nothing

' هنا ، نكتب اسم النموذج الخاص بالشاشة الافتتاحية
' اذا لم تكن ترغب في ان يتم فتح نموذج ما ، بعد عملية ربط الجداول ، امسح السطر التالي
'j DoCmd.OpenForm "Background"
DoCmd.OpenForm "frm"

MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

End Function
Function CheckFile(DBPath) As Integer

' هذه الدالة تقوم بالتأكد من وجود قاعدة البيانات الخلفية

On Error GoTo MyErr:
    
Open DBPath For Input As #1
Close
CheckFile = 1
Exit Function

MyErr:
Exit Function
    
End Function

Function Compare_FE_BE_Tables(BackFile)
On Error GoTo Err_Compare_FE_BE_Tables

    Dim stDocName As String
    Dim stLinkCriteria As String

'j    DoCmd.Close
'j    stDocName = "frm"
'j    DoCmd.OpenForm stDocName, , , stLinkCriteria

'    BackFile = GetOpenFile()
    
    
    If Len(BackFile & "") = 0 Or BackFile = 1 Then
        'this is a start up test
        BackFile = DLookup("[DBPathANDName]", "BackDBs", "[DBID] = 3")
        
        Dim Start_Up As Integer
        Start_Up = 1
    End If

    Dim FrontObj As AccessObject, FrontDB As Object
    Dim BackObj As TableDef, BackDB As Database, PW As String, PWD As String
    Set FrontDB = Application.CurrentData

    'the Selected BE
    Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, PWD)
    
    'Start with a table to look for
    For Each FrontObj In FrontDB.AllTables
        If left(FrontObj.NAME, 4) <> "MSys" And FrontObj.NAME <> "BackDBs" Then
'           FE =  FrontObj.NAME
            
            'look for that table in BE
            For Each BackObj In BackDB.TableDefs
                If left(BackObj.NAME, 4) <> "MSys" Then
'                    BE = BackObj.NAME
                    
                    If BackObj.NAME = FrontObj.NAME Then
                        
                        
                        
                        'check if tblmonths contain the value 12 in Month_No
                        If BackObj.NAME = "tblMonths" Then
                            Dim dbsNew  As Database
                            Dim rst_TQ As DAO.Recordset
                            Dim msg As Integer
                            
                            Set dbsNew = OpenDatabase(BackFile)
                            Set rst_TQ = dbsNew.OpenRecordset("SELECT * FROM tblMonths IN '" & BackFile & "'")
                            
                            rst_TQ.FindFirst "[Month_No]=12"
                            If rst_TQ.NoMatch Then
                                'MsgBox "Didn't find 12"
                                msg = 1
                                Compare_FE_BE_Tables = 1
                            Else
                                'MsgBox "OK"
                                Compare_FE_BE_Tables = 0
                                GoTo Found_It
                            End If
                            
                            rst_TQ.Close: Set rst_TQ = Nothing: Set dbsNew = Nothing
                        Else
                            Compare_FE_BE_Tables = 0
                            GoTo Found_It
                        End If
                         
                         
                         
'                        Compare_FE_BE_Tables = 0
'                        GoTo Found_It
                    Else
                        Compare_FE_BE_Tables = 1
                        
                    End If
                End If  'BackObj
            Next BackObj
            
        If Compare_FE_BE_Tables = 1 Then GoTo Not_Same

Found_It:
        End If  'FrontObj
    Next FrontObj
            
'All Good
        
        If Start_Up = 0 Then
            MsgBox "All FE tables exist in BE"
        Else
            DoCmd.OpenForm "Background"
        End If
           
        Set FrontDB = Nothing
        Set BackDB = Nothing
        
        'update the field in the table
        'DoCmd.SetWarnings False
        '    DoCmd.RunSQL ("UPDATE BackDBs SET DBPathANDName = " & BackFile & " WHERE DBID = 3")
        'DoCmd.SetWarnings True
       
        'link the tables
        'Call AutoLink
        
    Exit Function
    
Not_Same:

'No Good

    If msg = 0 Then
        MsgBox "The FE table : " & FrontObj.NAME & vbCrLf & _
               "Is Not in the BE"
    Else
        MsgBox "Didn't find 12 in tblMonths"
    End If

    Set FrontDB = Nothing
    Set BackDB = Nothing

    If Start_Up = 1 Then
        
        DoCmd.OpenForm "LinkDBsMain"
        
    End If
    


Exit_Compare_FE_BE_Tables:
    Exit Function

Err_Compare_FE_BE_Tables:
    MsgBox Err.Description
    Resume Exit_Compare_FE_BE_Tables

End Function

جعفر

605.3.test.mdb.zip

**رمهان** · فبراير 26, 2017

استاذ جعفر

بما ان العملية اصبحت هي مقارنة الجداول فمارايك استخدام استعلامين بربط مصدريهما جدول النظام msysobjects واحد القاعدة الحالية والاخر البعيدة وبالمعامل طبعا in لتحديد المسار البعيد . هنا استطيع معرفة الاختلاف بطريقة استعلام وسهلة جدا

اخي اوس

هل يمكن ان يرتبط اكثر من جدول باكثر من قاعدة ؟ ام انه فقط القاعدة التي مسارها مخزن بالجدول لديك والتي امامها خيار المسار صحيح؟

تحياتي

**jjafferr** · فبراير 26, 2017

9 دقائق مضت, رمهان said:

بما ان العملية اصبحت هي مقارنة الجداول فمارايك استخدام استعلامين بربط مصدريهما جدول النظام msysobjects واحد القاعدة الحالية والاخر البعيدة وبالمعامل طبعا in لتحديد المسار البعيد . هنا استطيع معرفة الاختلاف بطريقة استعلام وسهلة جدا

موضوع المقارنه انتهينا منه ، وطبعا هناك الطريقة التي تفضلت انت بها ،

ولكن المشكلة كانت في تطويع الكود ولف ذراعه لعمل اللي نريده :biggrin: والحمدلله تم ذلك :smile:

جعفر

**sandanet** · فبراير 26, 2017

5 ساعات مضت, رمهان said:

اخي اوس

هل يمكن ان يرتبط اكثر من جدول باكثر من قاعدة ؟ ام انه فقط القاعدة التي مسارها مخزن بالجدول لديك والتي امامها خيار المسار صحيح؟

تحياتي

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

**رمهان** · فبراير 26, 2017

اخي اوس

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

قليلا واعود

تحياتي

**sandanet** · فبراير 26, 2017

5 ساعات مضت, رمهان said:

استاذي الكريم جعفر اشكرك جزيل الشكر على تفاعلك المستمر في تقديم الحلول الرائعة :signthankspin: ولكن لايزال هنالك مشكلة بسيطة بإذن الله وهي عند اكتشاف عدم التطابق وفتح نموذج اختيار قاعدة البيانات فإن قمت بتجاهله واغلاقه بدون تحديد مكان القاعدة الصحيحة فعند فتح البرنامج لاينبهك بعدم صلاحية قاعدة البيانات .. المفروض ان البرنامج يجبر المستخدم على اختيار القاعدة الصحيحة والا فلن يعمل البرنامج اصلاقاً

اما بالنسبة لدالة المقارنة فاقترح تبسيطها وذلك عن طريق فحص قيمة معينة في قاعدة البيانات BE بدون مقارنة الجداول مع FE لاننا يكفينا ان نفحص قيمة مثلاً 12 في جدول tblMonths فان وجدت فهذا يعني ان القاعدة المرتبطة هي القاعدة الصحيحة والا فانه يعتبرها القاعدة الخطأ

واعتذر منك على كثرة تساؤلاتي :imsorry:

**رمهان** · فبراير 26, 2017

هذا كود سيقوم باخبارك هل الربط تمام ام لا

If CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.Type FROM MSysObjects AS MSysObjects_1 RIGHT JOIN [" & DLookup("DBPathANDName", "BackDBs", "found=true") & ";pwd=" & DLookup("mypass", "BackDBs", "found=true") & "].MSysObjects ON MSysObjects_1.ForeignName = MSysObjects.Name WHERE (((MSysObjects.Name) Not Like '*msys*') AND ((MSysObjects_1.ForeignName) Is Null) AND ((MSysObjects.Type)=1))").RecordCount <> 0 Then MsgBox ("الربط غير سليم")

الصقه في اي حدث يناسبك . مثلا عند التحميل للنموذج الرئيسي. والانتباه الى وجود البيانات التالية بالجدول BackDBs

1. وجود مسار للقاعدة الخلفية ووضع علاة صح ان المسار صحيح

2. هناك كلمة مرور للقاعدة الخلفية والتي مسارها اعلاه

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

تحياتي

**sandanet** · فبراير 26, 2017

رائع جداً اخي رمهان على هذا الابداع هذا اشبه بالحل السحري الذي لم اتوقعه بتاتاً كود سهل وبسيط الشكل لكن معقد الفهم "ننتظر منك شرحه طبعاً :biggrin: " لكنه يفي بالغرض فهو يكشف ما اذا كانت القاعدة المرتبطة هي القاعدة السليمة ام لا "لا اعرف كيف" وانا بدوري اضعه من جديد لانني ازلت النقطة الثانية الخاصة بضرورة وجود كلمة مرور للقاعدة الخلفية لاننا بالغالب نستغني عن وضع كلمة مرور عديمة الجدوى في القاعدة الخلفية

لذلك الكود يصبح هكذا

If CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.Type FROM MSysObjects AS MSysObjects_1 RIGHT JOIN [" & DLookup("DBPathANDName", "BackDBs", "found=true") & "].MSysObjects ON MSysObjects_1.ForeignName = MSysObjects.Name WHERE (((MSysObjects.Name) Not Like '*msys*') AND ((MSysObjects_1.ForeignName) Is Null) AND ((MSysObjects.Type)=1))").RecordCount <> 0 Then MsgBox ("الربط غير سليم")

ننتظر منك شرحه لو تكرمت

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

تحياتي

تم تعديل فبراير 27, 2017 بواسطه sandanet

mourad2012 · فبراير 27, 2017

4 ساعات مضت, sandanet said:

If CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.Type FROM MSysObjects AS MSysObjects_1 RIGHT JOIN [" & DLookup("DBPathANDName", "BackDBs", "found=true") & "].MSysObjects ON MSysObjects_1.ForeignName = MSysObjects.Name WHERE (((MSysObjects.Name) Not Like '*msys*') AND ((MSysObjects_1.ForeignName) Is Null) AND ((MSysObjects.Type)=1))").RecordCount <> 0 Then MsgBox ("الربط غير سليم")

فكرة رائعة اخي الكريم ،،، واليك بعض الملاحظات حبذا لو يتم تطبيقها

الان بعد الربط غير السليم يخبرنا انه تم الربط بطريقة غير سليمة ويفتح البرنامج باخطاء!!!

ونحتاج بعد ذلك الى اعادة تسمية القاعدة التي تم ربطها بالخطأ! كي يطالبنا بمكان القاعدة الصحيحة. أليس كذلك؟؟؟

ما رأيك استاذنا الحبيب رمهان لو أن الكود عند الربط غير السليم يقوم بازالة مسار القاعدة الخطأ من جدول ( BackDBs ) والخروج من البرنامج تلقائيا

وعند الدخول مرة اخرى يطالبنا بمكان الداتا الصحيحة،،،

ليصبح هكذا:

Dim strSQL As String

If CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.Type FROM MSysObjects AS MSysObjects_1 RIGHT JOIN [" & DLookup("DBPathANDName", "BackDBs", "found=true") & "].MSysObjects ON MSysObjects_1.ForeignName = MSysObjects.Name WHERE (((MSysObjects.Name) Not Like '*msys*') AND ((MSysObjects_1.ForeignName) Is Null) AND ((MSysObjects.Type)=1))").RecordCount <> 0 Then
MsgBox ("قاعدة البيانات التي تم ربطها بالبرنامج غير صحيحة، برجاء اختيار قاعدة اخرى")

strSQL = "Update BackDBs SET DBPathANDName = null"


DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
DoCmd.Quit
Else

End If

دمتم بود

تم تعديل فبراير 27, 2017 بواسطه mourad2012

**sandanet** · فبراير 27, 2017

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

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

تحياتي :biggrin:

test.zip

**رمهان** · فبراير 27, 2017

14 ساعات مضت, mourad2012 said:
فكرة رائعة اخي الكريم ،،، واليك بعض الملاحظات حبذا لو يتم تطبيقها

الان بعد الربط غير السليم يخبرنا انه تم الربط بطريقة غير سليمة ويفتح البرنامج باخطاء!!!

ونحتاج بعد ذلك الى اعادة تسمية القاعدة التي تم ربطها بالخطأ! كي يطالبنا بمكان القاعدة الصحيحة. أليس كذلك؟؟؟

ما رأيك استاذنا الحبيب رمهان لو أن الكود عند الربط غير السليم يقوم بازالة مسار القاعدة الخطأ من جدول ( BackDBs ) والخروج من البرنامج تلقائيا

وعند الدخول مرة اخرى يطالبنا بمكان الداتا الصحيحة،،،

ليصبح هكذا:
Dim strSQL As String

If CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.Type FROM MSysObjects AS MSysObjects_1 RIGHT JOIN [" & DLookup("DBPathANDName", "BackDBs", "found=true") & "].MSysObjects ON MSysObjects_1.ForeignName = MSysObjects.Name WHERE (((MSysObjects.Name) Not Like '*msys*') AND ((MSysObjects_1.ForeignName) Is Null) AND ((MSysObjects.Type)=1))").RecordCount <> 0 Then
MsgBox ("قاعدة البيانات التي تم ربطها بالبرنامج غير صحيحة، برجاء اختيار قاعدة اخرى")

strSQL = "Update BackDBs SET DBPathANDName = null"


DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
DoCmd.Quit
Else

End If
دمتم بود

مشاركة جميله اخ مراد وبها فائدة جزيت خيرا

19 ساعات مضت, sandanet said:
رائع جداً اخي رمهان على هذا الابداع هذا اشبه بالحل السحري الذي لم اتوقعه بتاتاً كود سهل وبسيط الشكل لكن معقد الفهم "ننتظر منك شرحه طبعاً " لكنه يفي بالغرض فهو يكشف ما اذا كانت القاعدة المرتبطة هي القاعدة السليمة ام لا "لا اعرف كيف" وانا بدوري اضعه من جديد لانني ازلت النقطة الثانية الخاصة بضرورة وجود كلمة مرور للقاعدة الخلفية لاننا بالغالب نستغني عن وضع كلمة مرور عديمة الجدوى في القاعدة الخلفية

لذلك الكود يصبح هكذا
If CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.Type FROM MSysObjects AS MSysObjects_1 RIGHT JOIN [" & DLookup("DBPathANDName", "BackDBs", "found=true") & "].MSysObjects ON MSysObjects_1.ForeignName = MSysObjects.Name WHERE (((MSysObjects.Name) Not Like '*msys*') AND ((MSysObjects_1.ForeignName) Is Null) AND ((MSysObjects.Type)=1))").RecordCount <> 0 Then MsgBox ("الربط غير سليم")
ننتظر منك شرحه لو تكرمت

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

تحياتي

الفكرة باختصار

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

بالتوفيق

8 ساعات مضت, sandanet said:

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

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

تحياتي

test.zip

اخي اوس

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

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

تحياتي

تم تعديل فبراير 27, 2017 بواسطه رمهان
الجدول الحالي

**sandanet** · فبراير 27, 2017

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

على العموم جاري حل طلاسم الكود

تحياتي

تسجيل الدخول

مشكلة عند تغيير قاعدة بيانات اخرى تحمل نفس اسم قاعدة البيانات الاصلية

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

sandanet

رمهان

sandanet

jjafferr

sandanet

رمهان

sandanet

jjafferr

رمهان

jjafferr

sandanet

jjafferr

sandanet

jjafferr

رمهان

jjafferr

sandanet

رمهان

sandanet

رمهان

sandanet

mourad2012

sandanet

رمهان

sandanet

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information