هل توجد طريقة لملف يحذف نفسه تلقائيا بعد انتهاء مدة معينة

[ابا اسماعيل]

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

إخواني الأعزاء، عندي طلب هل من طريقة لحذف ملف اكسيل تلقائيًا اذ لم يفتح بعد تاريخ معين في الحاسوب

يعنى الملف يحذف نفسه تلقائيا ما لم اقوم يفتح الملف  على الحاسوب

 

الملف يحذف نفسه تلقائيا بعد انتهاء المدة.xls

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

[الـعيدروس]

السلام عليكم

مالمراد بهذا هل تريد الملفات التي

لم يحصل ان تم فتحها لفترة زمنية تحذف

اذا كان هكذا ممكن اضافة وظيفة تشتغل كل ماتم فتح 

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

اذا وجدت الملف لم يحصل عليه تعديل مثلا لاكثر

من اسبوعين او ايام يقوم بحذفه

شوف بالكود التالي حدد عدد الايام في بداية الكود

وحط مسار الملف المعني وحفظ ملف الكود بصيغة Excel Add-In

بعد حفظه روح خيارات الاكسل  , الوظائف الاضافية انتقال وحفز

على الملف Addin الذي به الكود 

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

للملف المعني اذا وجد تاريخ اخر تعديل اكبر من التاريخ الحالي بالزمن المحدد يحذفه

ويشعرك برسالة ان تم حذف الملف

 

Sub Auto_open()
My_Kill
End Sub
Sub My_Kill()
    ' عدد الايام الافتراضية
    Const Day_Kil As Integer = 4
    Const Path_My_File As String = "C:\Users\abdulrhman\Desktop\سطح سابق\" & "33232323.xlsb"
    Dim File_Date
    Dim Date_Now
    Dim A
    If Chk_My_File(Path_My_File) Then
    File_Date = My_File_Edt(Path_My_File)
    Date_Now = Now()
    A = DateDiff("d", File_Date, Date_Now)
    If A > Day_Kil Then
    Kill Path_My_File
    MsgBox " تم حذف الملف المعني لم يفتح خلال المدة المحددة " & Path_My_File
    End If
    End If
End Sub
Private Function Chk_My_File(Fil_Name) As Boolean
    Dim x As String
    x = Dir(Fil_Name)
    If x <> "" Then Chk_My_File = True Else Chk_My_File = False
End Function
Function My_File_Edt(My_File_Name As String)
    Dim fs As Object, f As Object, s As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(My_File_Name)
    My_File_Edt = f.DateLastModified
    Set fs = Nothing: Set f = Nothing
End Function