تطبيق أحذ نسخه احتياطية مع حذف النسخه الاقدم

[kaser906]

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

يوجد بالمنتدى الكثير الكثير من الأمثلة على أخذ نسخه احتياطية

بعدة أفكار  ولو تتبعنا قليلا لوجدنا ان في الاغلب الاعم توجد مشاركة او بصمة للاستاذ ابو خليل

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

فأتمنى من استاذي ابو خليل انشاء موضوع خاص بأمثلته ووضعها جميعا في نفس الموضوع

مع شرح كل مثال ومميزاته وكيفية عمله

الآن أتي لما احتاجه

هذا المثال هو للاستاذ ابو خليل ويقوم

بأخذ نسخه احتياطية من قاعدة بيانات يتم اختيار مسارها من الجدول حيث تم تخزين المسار به مسبقا

وبالصيغة المختاره ايضا والمدة المحدده

لكن توجد مشكلة في المثال

بحيث ان اخذ النسخه وضغطها بملف بصيغة  winrar  وصيغة winzip لا تفتح وتظهر رسالة بأن الارشيف معطوب او رسالة مشابها لها

المطلوب

تعديل مشكلة نسخة winrar  و winzip

ايضا مطلوب الاحتفاظ بأخر ثلاث نسخ في مجلد النسخ الاحتياطي وحذف المتبقي

يوجد ايضا مثال للاستاذ ابو خليل بالنسبه لحذف النسخ  ولكن لم أتمكن من تطبيقه

المرفق x  هو المثال المطلوب التعديل عليه

المرفق db  توجد به طريقة حذف النسخ ولكنها بحسب اخر ثلاثة ايام والمطلوب حذف اقدم النسخ والاحتفاظ فقط بأخر ثلاث نسخ

 

x.rar

db.rar

[kaser906]

أعلى

[ابوخليل]

السلام عليكم

اقتباس

المرفق db  توجد به طريقة حذف النسخ ولكنها بحسب اخر ثلاثة ايام والمطلوب حذف اقدم النسخ والاحتفاظ فقط بأخر ثلاث نسخ

صحيح تفحص التاريخ  وآخر ثلاثة ايام  غير عملي فقد يتوقف العمل في البرنامج اكثر من ذلك وحينها يتم حذف جميع النسخ

رغم اننا في المثال اخذنا الحيطة باخذ نسخة عند الفتح  ، يبقى المسألة محتملة المخاطرة

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

Sub DeleteOldFiles()
    Dim fso As New FileSystemObject
    Dim fil As File
    Dim oldfile As File
    Dim BackUpPath As String 'This is the FOLDER where your backups are stored

    Do Until fso.GetFolder(BackUpPath).Files.Count < 4
        For Each fil In fso.GetFolder(BackUpPath).Files
            'Checks to see if this file is older than the oldest file thus far
            If oldfile Is Nothing Then Set oldfile = fil
            If oldfile.DateLastModified > fil.DateLastModified Then Set oldfile = fil
        Next fil
        fso.DeleteFile oldfile, True
        Set oldfile = Nothing
    Loop

End Sub

هذا الكود يتطلب تثبيت مكتبة   microsoft Script Runtime

[kaser906]

منذ ساعه, ابوخليل said:

السلام عليكم

صحيح تفحص التاريخ  وآخر ثلاثة ايام  غير عملي فقد يتوقف العمل في البرنامج اكثر من ذلك وحينها يتم حذف جميع النسخ

رغم اننا في المثال اخذنا الحيطة باخذ نسخة عند الفتح  ، يبقى المسألة محتملة المخاطرة

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

Sub DeleteOldFiles()
    Dim fso As New FileSystemObject
    Dim fil As File
    Dim oldfile As File
    Dim BackUpPath As String 'This is the FOLDER where your backups are stored

    Do Until fso.GetFolder(BackUpPath).Files.Count < 4
        For Each fil In fso.GetFolder(BackUpPath).Files
            'Checks to see if this file is older than the oldest file thus far
            If oldfile Is Nothing Then Set oldfile = fil
            If oldfile.DateLastModified > fil.DateLastModified Then Set oldfile = fil
        Next fil
        fso.DeleteFile oldfile, True
        Set oldfile = Nothing
    Loop

End Sub

هذا الكود يتطلب تثبيت مكتبة   microsoft Script Runtime

الله يعطيك العافية استاذ

لم تنجح محاولاتي في توظيف الكود بالشكل الصحيح

امل التعديل على المرفق x بالمشاركة الأولى

تم تعديل فبراير 3, 2018 بواسطه kaser906

[ابوخليل]

تفضل

لاحظ انه يحذف جميع الملفات ويبقي على أحدث 3 ملفات فقط 

x.rar

[kaser906]

7 ساعات مضت, ابوخليل said:

تفضل

لاحظ انه يحذف جميع الملفات ويبقي على أحدث 3 ملفات فقط 

x.rar

شكرا لك استاذ