منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - الدرس الحادي والعشرون

كاتب الموضوع : أحمد جمال

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

الاستيراد والتصدير Import & Export :

لن نقوم بالنسخ في هذا الدرس بما يمكن أن نسميه نسخاً احتياطياً كاملاً ، بل إن ما سنقوم به هو نسخ ملف قاعدة البيانات .
وسنبدأ بعمل اجراءين Copy_Me لعمل نسخة احتياطية ، و Copy_2 لاستعادة نسخة احتياطية ، وسنكتب الأمر بالشكل التالي :

كود :

Select Case Index

Case 0

Copy_Me

Case 1

Copy_2

End Select

والآن سنضيف أداة CommonDialog والتي من ضمن اختصاصاتها المربعات الحوارية للفتح والحفظ ، ولما كان MDIForm لا يقبل اضافة أي أدوات عليه سوى Picture فإننا سنضيف واحدة ونجعل Visible=False ، ونضع عليها الأداة .
ولاضافة الأداة اضغط Ctrl+T واختر Microsoft CommonDialog Control 6.0 .

برمجة الأمر

Copy_Me :

في بداية هذا الأمر سوف نكتب عبارة تلافي الأخطاء :

كود :

On Error GoTo 11

وفي آخر الأمر :

كود :

11:

Exit Sub

وهذا يخبر البرنامج أنه في حال وجدت خطأ توجه إلى السطر 11 ، وفي السطر 11 نأمره بانهاء الاجراء .

ولكي نجعل المستخدم عندما يضغط على ( الغاء الأمر - Cancel ) يخرج فإننا نجعل الغاء الأمر خطأ بالشكل التالي :

كود :

CommonDialog1.CancelError = True

ومن ثم نضبط العنوان ، ونوع الملفات التي سيتم حفظها :

كود :

CommonDialog1.CancelError = True

CommonDialog1.DialogTitle = "اختر المكان المطلوب للحفظ"

CommonDialog1.Filter = "Access File|*.mdb|"

وأخيراً نظهر المربع الحواري للحفظ :

كود :

CommonDialog1.ShowSave

ستعيد هذه الوظيفة الاسم الكامل للمسار + الملف في الخاصية FileName فيما تعيد اسم الملف فقط في FileTitle .

سنجري الآن سلسلة من الاختبارات على اسم الملف ، فنتأكد من أنه فارغ ، وأنه ليس ثم ملف يحمل نفس الاسم في نفس المكان :

كود :

If CommonDialog1.FileTitle = "" Then Exit Sub

If Dir(CommonDialog1.FileName) <> "" Then

MsgBox "توجد ملف بنفس الإسم في المسار المحدد", vbExclamation + arabic, "نسخ واستيراد"

Exit Sub

End If

والآن تمهيداً للنسخ لابد من اغلاق قاعدة البيانات :

كود :

D1.Close

ومن ثم أمر النسخ :

كود :

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

ونعيد فتح قاعدة البيانات من جديد :

كود :

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

)

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

كود :

MsgBox "تم نسخ قاعدة البيانات بنجاح إلى : " & CommonDialog1.FileName, vbInformation + arabic, "نسخ واستيراد"

وبهذا يصبح الكود الكامل لأمر

Copy_Me بالشكل التالي :

كود :

Private Sub Copy_Me()

On Error GoTo 11

CommonDialog1.CancelError = True

CommonDialog1.DialogTitle = "اختر المكان المطلوب للحفظ"

CommonDialog1.Filter = "Access File|*.mdb|"

CommonDialog1.ShowSave

If CommonDialog1.FileTitle = "" Then Exit Sub

If Dir(CommonDialog1.FileName) <> "" Then

MsgBox "توجد ملف بنفس الإسم في المسار المحدد", vbExclamation + arabic, "نسخ واستيراد"

Exit Sub

End If

D1.Close

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

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)

MsgBox "تم نسخ قاعدة البيانات بنجاح إلى : " & CommonDialog1.FileName, vbInformation + arabic, "نسخ واستيراد"

11:

Exit Sub

End Sub

يتبع ...

برمجة الأمر 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

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

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

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

RaggiTech

RaggiTech