[RaggiTech]

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

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

الاستيراد والتصدير 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

يتبع ...