17-10-12, 02:43 PM
كاتب الموضوع : 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]
ولا تنسـى أنه يجب أن تكون قاعدتي البيانات متطابقة فى الجداول الموجوده بكليهما وكذلك الحقول فالإجراء يقوم فقط بنقل البيانات وليس الحقول والجداول!
اتمنى أن تسـتفيدوا من الإجـراء, وإذا كان هنـاك أي إستفسار فأنا موجود إنشـاء الله
والسـلام عليكم ورحمة الله وبركاته