تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
كـود نقل البيانات من قاعدة بيانات الى أخرى Database Syncronization (هدية العيد -))
#1
كاتب الموضوع : Programmation

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

إخـواني الأعضـاء الكرام, كيف حال الجميع؟
أسـأل الله العظيم أن تكونوا فى أفضل حال وأتم عافية وكـل عـام أنتم بخير

لقد قُمت ببرمجة إجـراء يقوم بنقل البيانات من قاعدة بيانات أخرى ويدعم التعامل مع قواعد بيانات Access 97, 2000, 2003, 2007 واليـوم أُقدمه لكم هدية مني إليكم بمناسبة عيد الأضحى المبارك

الإجـراء:


كود :
[color=#000000][COLOR=#0000bb]Author[/color][color=#007700]: [/color][color=#0000bb]Programmtion[/color][color=#007700]([/color][color=#0000bb]OmarNegm[/color][COLOR=#007700])
Public [/COLOR][color=#0000bb]Sub accessDBSyncronization[/color][color=#007700]([/color][color=#0000bb]ByVal DatabaseFromPath [/color][color=#007700]As [/color][color=#0000bb]String[/color][color=#007700], [/color][color=#0000bb]ByVal DatabaseToPath [/color][color=#007700]As [/color][color=#0000bb]String[/color][color=#007700], [/color][color=#0000bb]Optional ByVal DatabaseFromPassword [/color][color=#007700]As [/color][color=#0000bb]String [/color][color=#007700]= [/color][color=#dd0000]""[/color][color=#007700], [/color][color=#0000bb]Optional ByVal DatabaseToPassword [/color][color=#007700]As [/color][color=#0000bb]String[/color][color=#007700], [/color][color=#0000bb]Optional ByVal IsAccess2007 [/color][color=#007700]As [/color][color=#0000bb]Boolean [/color][color=#007700]= [/color][color=#0000bb]False[/color][COLOR=#007700])
[/COLOR][COLOR=#0000bb]On Error GoTo errHandler

Dim frmCN [/COLOR][color=#007700]As New [/color][color=#0000bb]ADODB[/color][color=#007700].[/color][color=#0000bb]Connection[/color][color=#007700], [/color][color=#0000bb]toCN [/color][color=#007700]As New [/color][color=#0000bb]ADODB[/color][color=#007700].[/color][COLOR=#0000bb]Connection
Dim frmRS [/COLOR][color=#007700]As New [/color][color=#0000bb]ADODB[/color][color=#007700].[/color][color=#0000bb]Recordset[/color][color=#007700], [/color][color=#0000bb]toRS [/color][color=#007700]As New [/color][color=#0000bb]ADODB[/color][color=#007700].[/color][color=#0000bb]Recordset[/color][color=#007700], [/color][color=#0000bb]tblRS [/color][color=#007700]As New [/color][color=#0000bb]ADODB[/color][color=#007700].[/color][COLOR=#0000bb]Recordset
Dim Tbls [/COLOR][color=#007700]As [/color][color=#0000bb]String[/color][color=#007700], [/color][color=#0000bb]arrTbls[/color][color=#007700]() As [/color][color=#0000bb]String[/color][color=#007700], [/color][color=#0000bb]frmProvider [/color][color=#007700]As [/color][color=#0000bb]String[/color][color=#007700], [/color][color=#0000bb]toProvider [/color][color=#007700]As [/color][COLOR=#0000bb]String
Dim tblI [/COLOR][color=#007700]As [/color][color=#0000bb]Integer[/color][color=#007700], [/color][color=#0000bb]fldI [/color][color=#007700]As [/color][COLOR=#0000bb]Integer

[/COLOR][color=#007700]If [/color][color=#0000bb]IsAccess2007 [/color][color=#007700]= [/color][COLOR=#0000bb]True Then
   frmProvider [/COLOR][color=#007700]= [/color][color=#dd0000]"Provider=Microsoft.ACE.12.0;JET OLEDB:Database Password=" [/color][color=#007700]& [/color][color=#0000bb]DatabaseFromPassword [/color][color=#007700]& [/color][color=#dd0000]";Data Source=" [/color][color=#007700]& [/color][COLOR=#0000bb]DatabaseFromPath
   toProvider [/COLOR][color=#007700]= [/color][color=#dd0000]"Provider=Microsoft.ACE.12.0;JET OLEDB:Database Password=" [/color][color=#007700]& [/color][color=#0000bb]DatabaseToPassword [/color][color=#007700]& [/color][color=#dd0000]";Data Source=" [/color][color=#007700]& [/color][COLOR=#0000bb]DatabaseToPath
  [/COLOR][COLOR=#007700]Else
   [/COLOR][color=#0000bb]frmProvider [/color][color=#007700]= [/color][color=#dd0000]"Provider=Microsoft.JET.OLEDB.4.0;JET OLEDB:Database Password=" [/color][color=#007700]& [/color][color=#0000bb]DatabaseFromPassword [/color][color=#007700]& [/color][color=#dd0000]";Data Source=" [/color][color=#007700]& [/color][COLOR=#0000bb]DatabaseFromPath
   toProvider [/COLOR][color=#007700]= [/color][color=#dd0000]"Provider=Microsoft.JET.OLEDB.4.0;JET OLEDB:Database Password=" [/color][color=#007700]& [/color][color=#0000bb]DatabaseToPassword [/color][color=#007700]& [/color][color=#dd0000]";Data Source=" [/color][color=#007700]& [/color][COLOR=#0000bb]DatabaseToPath
End [/COLOR][COLOR=#007700]If


If [/COLOR][color=#0000bb]frmCN[/color][color=#007700].[/color][color=#0000bb]State [/color][color=#007700]= [/color][color=#0000bb]1 Then frmCN[/color][color=#007700].[/color][COLOR=#0000bb]Close
frmCN[/COLOR][color=#007700].[/color][COLOR=#0000bb]Open frmProvider

[/COLOR][color=#007700]If [/color][color=#0000bb]toCN[/color][color=#007700].[/color][color=#0000bb]State [/color][color=#007700]= [/color][color=#0000bb]1 Then toCN[/color][color=#007700].[/color][COLOR=#0000bb]Close
toCN[/COLOR][color=#007700].[/color][COLOR=#0000bb]Open toProvider

Set tblRS [/COLOR][color=#007700]= [/color][color=#0000bb]frmCN[/color][color=#007700].[/color][color=#0000bb]OpenSchema[/color][color=#007700]([/color][color=#0000bb]adSchemaTables[/color][COLOR=#007700])

[/COLOR][color=#0000bb]Tbls [/color][color=#007700]= [/color][COLOR=#dd0000]""

[/COLOR][color=#007700]While [/color][color=#0000bb]Not tblRS[/color][color=#007700].[/color][color=#0000bb]EOF [/color][color=#007700]= [/color][COLOR=#0000bb]True
  [/COLOR][color=#007700]If [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysAccessStorage" [/color][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysACEs" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysNavPaneGroupCategories" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysNavPaneGroups" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysNavPaneGroupToObjects" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysNavPaneObjectIDs" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysObjects" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysQueries" [/color][COLOR=#0000bb]_
  [/COLOR][color=#007700]And [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]<> [/color][color=#dd0000]"MSysRelationships" [/color][COLOR=#0000bb]Then
    [/COLOR][color=#007700]If [/color][color=#0000bb]Tbls [/color][color=#007700]= [/color][color=#dd0000]"" [/color][COLOR=#0000bb]Then
         Tbls [/COLOR][color=#007700]= [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][COLOR=#0000bb]Value
       [/COLOR][COLOR=#007700]Else
         [/COLOR][color=#0000bb]Tbls [/color][color=#007700]= [/color][color=#0000bb]Tbls [/color][color=#007700]& [/color][color=#dd0000]"," [/color][color=#007700]& [/color][color=#0000bb]tblRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#dd0000]"TABLE_NAME"[/color][color=#007700]).[/color][COLOR=#0000bb]Value
    End [/COLOR][COLOR=#007700]If
  [/COLOR][color=#0000bb]End [/color][COLOR=#007700]If
    [/COLOR][color=#0000bb]tblRS[/color][color=#007700].[/color][COLOR=#0000bb]MoveNext
Wend
  
arrTbls [/COLOR][color=#007700]= [/color][color=#0000bb]Split[/color][color=#007700]([/color][color=#0000bb]Tbls[/color][color=#007700], [/color][color=#dd0000]","[/color][COLOR=#007700])

For [/COLOR][color=#0000bb]tblI [/color][color=#007700]= [/color][color=#0000bb]0 To UBound[/color][color=#007700]([/color][color=#0000bb]arrTbls[/color][COLOR=#007700])
    If [/COLOR][color=#0000bb]frmRS[/color][color=#007700].[/color][color=#0000bb]State [/color][color=#007700]= [/color][color=#0000bb]1 Then frmRS[/color][color=#007700].[/color][COLOR=#0000bb]Close
    frmRS[/COLOR][color=#007700].[/color][color=#0000bb]CursorLocation [/color][color=#007700]= [/color][COLOR=#0000bb]adUseClient
    frmRS[/COLOR][color=#007700].[/color][color=#0000bb]Open [/color][color=#dd0000]"SELECT * FROM " [/color][color=#007700]& [/color][color=#0000bb]arrTbls[/color][color=#007700]([/color][color=#0000bb]tblI[/color][color=#007700]), [/color][color=#0000bb]frmCN[/color][color=#007700], [/color][color=#0000bb]adOpenDynamic[/color][color=#007700], [/color][COLOR=#0000bb]adLockOptimistic
    
    [/COLOR][color=#007700]If [/color][color=#0000bb]toRS[/color][color=#007700].[/color][color=#0000bb]State [/color][color=#007700]= [/color][color=#0000bb]1 Then toRS[/color][color=#007700].[/color][COLOR=#0000bb]Close
    toRS[/COLOR][color=#007700].[/color][color=#0000bb]CursorLocation [/color][color=#007700]= [/color][COLOR=#0000bb]adUseClient
    toRS[/COLOR][color=#007700].[/color][color=#0000bb]Open [/color][color=#dd0000]"SELECT * FROM " [/color][color=#007700]& [/color][color=#0000bb]arrTbls[/color][color=#007700]([/color][color=#0000bb]tblI[/color][color=#007700]), [/color][color=#0000bb]toCN[/color][color=#007700], [/color][color=#0000bb]adOpenDynamic[/color][color=#007700], [/color][COLOR=#0000bb]adLockOptimistic
    
    [/COLOR][color=#007700]If [/color][color=#0000bb]frmRS[/color][color=#007700].[/color][color=#0000bb]RecordCount [/color][color=#007700]> [/color][COLOR=#0000bb]0 Then
       frmRS[/COLOR][color=#007700].[/color][COLOR=#0000bb]MoveFirst
       toCN[/COLOR][color=#007700].[/color][color=#0000bb]Execute [/color][color=#dd0000]"DELETE * FROM " [/color][color=#007700]& [/color][color=#0000bb]arrTbls[/color][color=#007700]([/color][color=#0000bb]tblI[/color][COLOR=#007700])
       Do [/COLOR][color=#0000bb]Until frmRS[/color][color=#007700].[/color][color=#0000bb]EOF [/color][color=#007700]= [/color][COLOR=#0000bb]True
         toRS[/COLOR][color=#007700].[/color][COLOR=#0000bb]AddNew
          [/COLOR][color=#007700]For [/color][color=#0000bb]fldI [/color][color=#007700]= [/color][color=#0000bb]0 To frmRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700].[/color][color=#0000bb]Count [/color][color=#007700]- [/color][COLOR=#0000bb]1
            [/COLOR][color=#007700]If [/color][color=#0000bb]IsNull[/color][color=#007700]([/color][color=#0000bb]frmRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#0000bb]fldI[/color][color=#007700]).[/color][color=#0000bb]Value[/color][color=#007700]) = [/color][COLOR=#0000bb]False Then
              toRS[/COLOR][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#0000bb]fldI[/color][color=#007700]).[/color][color=#0000bb]Value [/color][color=#007700]= [/color][color=#0000bb]frmRS[/color][color=#007700].[/color][color=#0000bb]Fields[/color][color=#007700]([/color][color=#0000bb]fldI[/color][color=#007700]).[/color][COLOR=#0000bb]Value
            End [/COLOR][COLOR=#007700]If
          [/COLOR][COLOR=#0000bb]Next fldI
          toRS[/COLOR][color=#007700].[/color][COLOR=#0000bb]Update
          frmRS[/COLOR][color=#007700].[/color][COLOR=#0000bb]MoveNext
       Loop
    End [/COLOR][COLOR=#007700]If
[/COLOR][COLOR=#0000bb]Next tblI

errHandler[/COLOR][COLOR=#007700]:
If [/COLOR][color=#0000bb]Not Err[/color][color=#007700].[/color][color=#0000bb]Number [/color][color=#007700]= [/color][COLOR=#0000bb]0 Then
   MsgBox [/COLOR][color=#dd0000]"An Error Has Occurred:" [/color][color=#007700]& [/color][color=#0000bb]vbNewLine [/color][color=#007700]& [/color][color=#dd0000]"Error Description: " [/color][color=#007700]& [/color][color=#0000bb]Err[/color][color=#007700].[/color][COLOR=#0000bb]Description
   Err[/COLOR][color=#007700].[/color][COLOR=#0000bb]Clear
End [/COLOR][COLOR=#007700]If

[/COLOR][color=#0000bb]Set frmCN [/color][color=#007700]= [/color][COLOR=#0000bb]Nothing
Set toCN [/COLOR][color=#007700]= [/color][COLOR=#0000bb]Nothing
Set frmRS [/COLOR][color=#007700]= [/color][COLOR=#0000bb]Nothing
Set toRS [/COLOR][color=#007700]= [/color][COLOR=#0000bb]Nothing
Set tblRS [/COLOR][color=#007700]= [/color][COLOR=#0000bb]Nothing
End Sub  
[/COLOR][/COLOR]

كيفية التعامل مع الإجـراء:

الإجراء يحتوى على خمسة معاملات إثنين منهم إجبارية والثلاثة الباقية إختيارية وكلهم من النوع String عدا الأخير فهو من النوع Boolean وهم على التوالي:

1 - DatabaseFromPath : (إجباري) ويتم التعويض عنه بمسـار قاعدة البيانات الأساسية (المُنتقل منها البيانات).
2 - DatabaseToPath : (إجباري) ويتم التعويض عنه بمسـار قاعدة البيانات الثانية (المُنتقل إليها البيانات).
3 - DatabaseFromPassword : (إختياري) ويتم التعويض عنه بكلمة مرور قاعدة البيانات الأساسية (إذا كانت تحتوى على كلمة مرور فهو إختياري).
4 - DatabaseToPassword : (إختياري) ويتم التعويض عنه بكلمة مرور قاعدة البيانات الثانية (إذا كانت تحتوى على كلمة مرور فهو إختياري).
5 - IsAccess2007 : (إختياري) ويحمل القيمة True إذا كنت ستتعامل مع قواعد بيانات Access 2007 فيما عدا ذلك فيحمل القيمة False أو تتجاهله حيث أن القيمة الإفتراضية له هي False .

ويُمكنك التعامل معه برمجياً كالتالي:

ضع الكود داخل Module وبعدها يُمكنك إستدعائه من أي مكان داخل المشـروع هكـذا:

الأمر التالي سوف يقوم بنقل جميع البيانات من قاعدة البيانات MyData الموجودة فى المسـار D:\New Folder الى قاعدة البيانات MyData2 الموجودة فى المسـار C:\New Folder وكلا القاعدتين من من نوع Access 2003 القاعدتين تحتويا على كلمة مرور وهي 123 :


كود :
[color=#000000][COLOR=#0000bb]accessDBSyncronization [/color][color=#dd0000]"D:\New Folder\MyData.mdb"[/color][color=#007700], [/color][color=#dd0000]"C:\New Folder\MyData2.mdb"[/color][color=#007700], [/color][color=#dd0000]"123"[/color][color=#007700], [/color][COLOR=#dd0000]"123"  
[/COLOR][color=#0000bb][/color][/COLOR]

لاحظ تجاهل المعامل الأخير IsAccess2007 وذلك لان قيمته الإفتراضية False ومع كُل يُمكنك كتابته بهذه الطريقة إذا كنت لا تُريد تجاهله:


كود :
[color=#000000][COLOR=#0000bb]accessDBSyncronization [/color][color=#dd0000]"D:\New Folder\MyData.mdb"[/color][color=#007700], [/color][color=#dd0000]"C:\New Folder\MyData2.mdb"[/color][color=#007700], [/color][color=#dd0000]"123"[/color][color=#007700], [/color][color=#dd0000]"123"[/color][color=#007700], [/color][COLOR=#0000bb]False  
[/COLOR][/COLOR]

كلا الطريقتين صحيحة.

الأمر التالي سوف يقوم بنقل جميع البيانات من قاعدة البيانات MyData الموجودة فى المسـار D:\New Folder الى قاعدة البيانات MyData2 الموجودة فى المسـار C:\New Folder وكلا القاعدتين من من نوع Access 2007 القاعدتين لا تحتويا على كلمة مرور :


كود :
[color=#000000][COLOR=#0000bb]accessDBSyncronization [/color][color=#dd0000]"D:\New Folder\MyData.accdb"[/color][color=#007700], [/color][color=#dd0000]"C:\New Folder\MyData2.accdb"[/color][color=#007700], , , [/color][COLOR=#0000bb]True  
[/COLOR][/COLOR]

لاحظ تجاهل معاملى كلمة المرور لعدم وجود كلمة مرور للقاعدتين وأيضاً يُمكنك كتابة الأمر هكذا إذا كنت لا تُريد تجاهلهما:


كود :
[color=#000000][COLOR=#0000bb]accessDBSyncronization [/color][color=#dd0000]"D:\New Folder\MyData.accdb"[/color][color=#007700], [/color][color=#dd0000]"C:\New Folder\MyData2.accdb"[/color][color=#007700], [/color][color=#dd0000]""[/color][color=#007700], [/color][color=#dd0000]""[/color][color=#007700], [/color][COLOR=#0000bb]True  
[/COLOR][/COLOR]

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

اتمنى أن تسـتفيدوا من الإجـراء, وإذا كان هنـاك أي إستفسار فأنا موجود إنشـاء الله
والسـلام عليكم ورحمة الله وبركاته
}}}
تم الشكر بواسطة:



التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم