كيف يكون النسخ الاحطياطى عند الخروج بابسط الصور

تفضل اخى

هذا الكود به ماتحتاج و زيادة

Private Sub EXIT_Click()
Dim msg As String
msg = MsgBox("سيتم اغلاق البرنامج ...    هل تريد عمل نسخة احطياطية ", vbCritical + vbYesNoCancel, "تحذير")
If msg = vbYes Then

On Error GoTo MyErr

Dim oldfile, NewFile, CopyMyDB
oldfile = [CurrentProject].[Path] & "\" & "2.mdb"
newpath = [CurrentProject].[Path]

' Next line shows the required path for the backup database
NewFile = newpath & "\" & "2x.mdb"
CopyMyDB = "cmd.exe /C copy " & """" & oldfile & """" & " " & """" & NewFile & """"
Shell CopyMyDB, 0

'ضغط و اصلاح القاعدة عند وصولها الى حجم معين
'********************************************
      'Dim vStatusBar As Variant

         ' If FileLen(CurrentDb.Name) > 5000000 Then   '5 mb
              'Application.SetOption ("Auto Compact"), 1
             ' Application.SetOption "Show Status Bar", True
              'vStatusBar = SysCmd(acSysCmdSetStatus, "The application must be compacted, please do not interfere with the Compacting process!")
         ' Else
             ' Application.SetOption ("Auto Compact"), 0
         ' End If
'***************************************************
MyErr:
If Err.Number <> 0 Then
MsgBox Err.Number & " - " & Err.Description
End If

DoCmd.Quit
 ElseIf msg = vbNo Then
 DoCmd.Quit
Else

 End If


End Sub

جزاكم الله خيرا

بحق شهر رمضان اجعله يارب فى ميزان حسناته

لكن اخى الحبيب فرضا انك تعمل كل يوم نسخه فأن الكود الذى وضعته رغم جودته العاليه لا يقوم الا بعمل نسخه واحده فقط فارجو منك وضع ترقيم لكل نسخه حتى يقبل عمل عدة نسخ بشكل يومى

'ضغط و اصلاح القاعدة عند وصولها الى حجم معين

'********************************************

'Dim vStatusBar As Variant

' If FileLen(CurrentDb.Name) > 5000000 Then '5 mb

'Application.SetOption ("Auto Compact"), 1

' Application.SetOption "Show Status Bar", True

'vStatusBar = SysCmd(acSysCmdSetStatus, "The application must be compacted, please do not interfere with the Compacting process!")

' Else

' Application.SetOption ("Auto Compact"), 0

' End Ifهل معنى ما هو مكتوب بالكود ان بعد بلوغ القاعده 5 ميجا سيتم فى كل مره اقوم بنسخها سيتم عمل ضغط واصلاح لها اليس فى ذلك كثره فى العدد لعملية الضغط والاصلاح خاصه اننى اقوم بعملية النسخ كثيرا

اخى الفاضل

بخصوص عدد النسخ

يمكنك اضافة التاريخ الى اسم النسخة

بتعديل هذا السطر

NewFile = newpath & "\" & "2x.mdb"

الى

NewFile = newpath & "\" & date() &"_2.mdb"

اما بخصوص الضغط و الاصلاح

فانت الذى يحدد الحجم الذى يتم على اساسه الضغط حسب حجم الملف لديك

و حجم 5 ميجا مجرد مثال

و بالتوفيق

اخى الفاضل استحملنى لاخر المشوار

بعدما قمت بعمل التعديل لاتقوم القاعده بعملية النسخ اطلاقا

2.rar

اخوانى الافاضل ارجو منكم المشاركه جميعا دون تخصيص لاحد او بخس للمشاركات السابقه

لقد قمت بنسخ خليط من الاكواد ففى القاعده الاولى يوجدهذا الكود بزر الخروج واخذت جزء منه من القاعده الثانيه فكانت نتيجة النسخ الاحطياطى القاعده الثالثه على شكل صوره ستجدونها بعد فك الضغط على شكل صوره فما هو التعديل المناسب لكى تخرج نتيجة النسخ الاحطياطى على شكل برنامج الاكسس الذى نعهده

3.rar

1.rar

2.rar

مرسي النجار كتب:

اخى الفاضل استحملنى لاخر المشوار

بعدما قمت بعمل التعديل لاتقوم القاعده بعملية النسخ اطلاقا

عندك حق اخى

لم اجرب الكود

استخدم هذا التعديل و سيلبى طلبك ان شاء الله

NewFile = newpath & "\" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & ".mdb"

يمكنك اضافة الوقت اذا اردت بنفس الطريقة

مرسي النجار كتب:

اخوانى الافاضل ارجو منكم المشاركه جميعا دون تخصيص لاحد او بخس للمشاركات السابقه

لقد قمت بنسخ خليط من الاكواد ففى القاعده الاولى يوجدهذا الكود بزر الخروج واخذت جزء منه من القاعده الثانيه فكانت نتيجة النسخ الاحطياطى القاعده الثالثه على شكل صوره ستجدونها بعد فك الضغط على شكل صوره فما هو التعديل المناسب لكى تخرج نتيجة النسخ الاحطياطى على شكل برنامج الاكسس الذى نعهده

المشكلة اخى فى الكود انك حذفت امتداد قاعدة البيانات

اليك هذا التعديل البسيط

NewFile = "D:\الرصد" & "\" & DBwithoutEXT & "    Backup    Date " & Format(Date, "yyyy_mm_dd") & "      Time " & Format(Now(), "Hh Nn AMPM") & Right(CurrentDb.Name, 4)

لاحظ الجزء الاخير فى السطر

جزاكم الله عنى خير الجزاء

اخي الكريم

بارك الله فيك

انا تخرج عندي خطأ هنا

newpath = [CurrentProject].[Path]

ماذا تعني

newpath