[RaggiTech]

برمجة الأمر Copy_2 :

كما هو الحال مع الأمر السابق ، نضع أكواد الخطأ ونضبط خصائص المربع الحواري في بداية الكود ، إلأ أننا سنظهر Open بدلاً من Save .

كود :

On Error GoTo 12
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "اختر مكان القاعدة المطلوبة"
CommonDialog1.Filter = "Access File|*.mdb|"
CommonDialog1.ShowOpen

ومن ثم نتأكد من وجود الملف :

كود :

If CommonDialog1.FileTitle = "" Then Exit Sub

If Dir(CommonDialog1.FileName) = "" Then
MsgBox "اسم قاعدة بيانات خاطئ", vbExclamation + arabic, "نسخ واستيراد"
Exit Sub
End If

ونظهر رسالة تحذيرية بأن استيراد القاعدة سوف يحذف القاعدة الحالية - يمكن لتلافي ذلك نسخها احتياطياً قبل ذلك - .

كود :

Dim SuRe
SuRe = MsgBox("إن استيرادك لقاعدة البيانات هذه سوف يؤدي إلى حذف القاعدة الحالية ، هل ما زلت تريد الاستمرار ؟", vbExclamation + arabic + vbYesNo, "نسخ واستيراد")
If SuRe = vbNo Then Exit Sub

نغلق قاعدة البيانات الحالية ، ونزيل خاصية للقراءة فقط إن وجدت ، ثم نحذفها ونجلب القاعدة الجديدة مكانها :

كود :

D1.Close

SetAttr Folder & "db1.mdb", vbNormal
Kill Folder & "db1.mdb"

FileCopy CommonDialog1.FileName, Folder & "db1.mdb"

نفتح قاعدة البيانات مجدداً ، ونخزن البيانات الجديدة في Info ثم نستدعي الدالة Start .

* لم نقم بذلك في الاجراء السابق لأن قاعدة البيانات لم تتغير .

كود :

Set D1 = DBEngine.Workspaces(0).OpenDatabase(Folder & "Db1.mdb", False, False, ";pwd=" & PassWord)

Set T1 = D1.OpenRecordset("Tb_Product", dbOpenTable)
Set T2 = D1.OpenRecordset("Tb_Category", dbOpenTable)
Set T3 = D1.OpenRecordset("Tb_Factory", dbOpenTable)
Set T5 = D1.OpenRecordset("Tb_Sel_Bay", dbOpenTable)

Set T4 = D1.OpenRecordset("Tb_User", dbOpenTable)
Info(0) = T4!User_Name
Info(1) = T4!PassWord
Info(2) = T4!Name
Info(3) = T4!Telephone
Info(4) = T4!More
T4.Close

Call Start

ونظهر رسالة باتمام العملية بنجاح :

كود :

MsgBox "تم استيراد قاعدة البيانات بنجاح من : " & CommonDialog1.FileName & Chr(13) & "سوف يتم الآن بدء تشغيل هذه القاعدة", vbInformation + arabic, "نسخ واستيراد"

وبهذا يكون الأمر الكامل كما يلي :

كود :

Private Sub Copy_2()
On Error GoTo 12
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "اختر مكان القاعدة المطلوبة"
CommonDialog1.Filter = "Access File|*.mdb|"
CommonDialog1.ShowOpen

If CommonDialog1.FileTitle = "" Then Exit Sub

If Dir(CommonDialog1.FileName) = "" Then
MsgBox "اسم قاعدة بيانات خاطئ", vbExclamation + arabic, "نسخ واستيراد"
Exit Sub
End If

Dim SuRe
SuRe = MsgBox("إن استيرادك لقاعدة البيانات هذه سوف يؤدي إلى حذف القاعدة الحالية ، هل ما زلت تريد الاستمرار ؟", vbExclamation + arabic + vbYesNo, "نسخ واستيراد")
If SuRe = vbNo Then Exit Sub

D1.Close

SetAttr Folder & "db1.mdb", vbNormal
Kill Folder & "db1.mdb"

FileCopy CommonDialog1.FileName, Folder & "db1.mdb"

Set D1 = DBEngine.Workspaces(0).OpenDatabase(Folder & "Db1.mdb", False, False, ";pwd=" & PassWord)

Set T1 = D1.OpenRecordset("Tb_Product", dbOpenTable)
Set T2 = D1.OpenRecordset("Tb_Category", dbOpenTable)
Set T3 = D1.OpenRecordset("Tb_Factory", dbOpenTable)
Set T5 = D1.OpenRecordset("Tb_Sel_Bay", dbOpenTable)

Set T4 = D1.OpenRecordset("Tb_User", dbOpenTable)
Info(0) = T4!User_Name
Info(1) = T4!PassWord
Info(2) = T4!Name
Info(3) = T4!Telephone
Info(4) = T4!More
T4.Close

Call Start

MsgBox "تم استيراد قاعدة البيانات بنجاح من : " & CommonDialog1.FileName & Chr(13) & "سوف يتم الآن بدء تشغيل هذه القاعدة", vbInformation + arabic, "نسخ واستيراد"
12:
Exit Sub
End Sub

الملف حتى هذه اللحظة من الدروس موجود في المرفقات ...

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