تقييم الموضوع :
  • 1 أصوات - بمعدل 5
  • 1
  • 2
  • 3
  • 4
  • 5
الدرس الحادي والعشرون - الإستيراد والتصدير لقاعدة البيانات
#1
كاتب الموضوع : أحمد جمال

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


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

يتبع ...
}}}
تم الشكر بواسطة:
#2
برمجة الأمر 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
الملف حتى هذه اللحظة من الدروس موجود في المرفقات ...


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


الملفات المرفقة
.zip   prog17.zip (الحجم : 188.08 ك ب / التحميلات : 169)
}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  الدرس الرابع والثلاثون والأخير - نبذة عن العملية العكسية + تجهيز البرنامج على Cd RaggiTech 0 11,110 15-10-12, 09:10 AM
آخر رد: RaggiTech
  الدرس الثالث والثلاثون - كيفية عمل اعداد Setup للبرنامج RaggiTech 0 3,979 15-10-12, 09:08 AM
آخر رد: RaggiTech
  الدرس الثاني والثلاثون - التحويل إلى exe RaggiTech 0 4,065 15-10-12, 09:07 AM
آخر رد: RaggiTech
  الدرس الحادي والثلاثون - تعددية المستخدمين - البحث وطباعة الفواتير - التعليمات ... RaggiTech 2 4,951 15-10-12, 09:05 AM
آخر رد: RaggiTech
  الدرس الثلاثون - التعامل مع شريط الأدوات ToolBar RaggiTech 0 3,822 15-10-12, 08:59 AM
آخر رد: RaggiTech
  الدرس التاسع والعشرون - التعامل مع أشرطة الحالة Statues Bar RaggiTech 0 3,602 15-10-12, 08:57 AM
آخر رد: RaggiTech
  الدرس الثامن والعشرون -الطباعة في البرنامج . RaggiTech 4 5,293 15-10-12, 08:56 AM
آخر رد: RaggiTech
  الدرس السابع والعشرون - مقدمة إلى التعامل مع التقارير من خلال DataReport RaggiTech 2 6,107 15-10-12, 08:45 AM
آخر رد: RaggiTech
  الدرس السادس والعشرون - التقارير اليومية ، والتقارير بين تاريخين RaggiTech 1 4,347 15-10-12, 08:39 AM
آخر رد: RaggiTech
  الدرس الخامس والعشرون - الإحصائيات والرسوم البيانية RaggiTech 0 3,766 15-10-12, 08:37 AM
آخر رد: RaggiTech

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


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