انتحار جماعي لكل ملفات الاكسيل في مسار معين حسب شرط معين

بسم الله الرحمن الرحيم

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

ثانيا

نضع لكم كود لحذف جميع ملفات الاكسيل من مسار معين عند فتح ملف اكسيل وتحقق الشرط المحدد

الكود في حدث فتح المصنف

 Sub Clear_All_Files_And_SubFolders_In_Folder()  
 Dim FSO As Object  
 Dim MyPath As String  
 If Date > DateValue("15/9/2016") Then  
 Set FSO = CreateObject("scripting.filesystemobject")  
 MyPath = "D:\Yasser" '<<مسارالملفات والفولدرات المرادمسحهم  
 If Right(MyPath, 1) = "\" Then  
 MyPath = Left(MyPath, Len(MyPath) - 1)  
 End If  
 If FSO.FolderExists(MyPath) = False Then  
 'MsgBox MyPath & " doesn't exist"  
 Exit Sub  
 End If  
 On Error Resume Next  
 FSO.deletefile MyPath & "\*.xl*", True 'مسح ملفات الاكسيل اذاكانت تريد مسح جميع الملفات ضع * بدلا من الاكسيل  
 ' FSO.deletefolder MyPath & "\*.*", True' اذا كنت تريدمسح كل الفولدرات الموجودة داخل المسار المحدد  
 On Error GoTo 0  
 End If  
 End Sub 0

كل ما عليكم هو التعديل على المسارات المطلوبة

لتحميل الملف من هنا

ومن الممكن حذف اي ملفات اخرى غير الاكسيل فقط يتم تحديد امتداد الملفات بالكود 

وشكرا

شارك المقال

شاركه على فيسبوكشاركه على جوجل+