Code tự động xoá Folder theo ngày?

[hoabinh2012]

Chào các bạn,

Mình sưu tầm được đoạn code bên dưới tự động xoá file cũ và chỉ để lại những file gần đây nhất.... Trong đoạn code dưới sẽ tự động xoá toàn bộ những file cũ và chỉ để lại những file 30 ngày mới nhất trong đường dẫn "D:\Test\". Mình không phải dân lập trình nên post đoạn code này lên nhờ các bạn giúp đỡ để hoàn thành mong đợi của mình như sau:

Mình muốn xoá tất cả các subfolder chứ không phải file trong đường dẫn "D:\Test". Và chỉ muốn để lại các subfolder của 30 ngày mới nhất trong đường dẫn này.

Cảm ơn các bạn!


Option Explicit
On Error Resume Next
Dim oFSO, oFolder, sDirectoryPath
Dim oFileCollection, oFile, sDir
Dim iDaysOld sDirectoryPath = "D:\Test"
iDaysOld = 30
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files
For each oFile in oFileCollection
If LCase(Right(Cstr(oFile.Name), 3)) = "001" Then

If oFile.DateLastModified < (Date() - iDaysOld) Then
oFile.Delete(True)
End If

End If
Next
Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
Set oFile = Nothing

 

[hoabinh2012]

Cuối cùng mình đã sưu tầm và mò ra như mong đợi của minh rồi. Share cho các bạn, nếu bạn nào cần dùng thì xem đoạn code này nhe!

Dim fso, fldr
Dim iDaysold
Set fso = CreateObject("Scripting.FilesystemObject")

Set fldr = fso.GetFolder("D:\Test\Test Folder")

iDaysOld = 7

For Each subf In fldr.SubFolders

If subf.DateLastModified < (Date() - iDaysold) then

subf.Delete True

End If

Next

For Each fsofile In fldr.Files

fsofile.Delete True

Next
Set fso = Nothing
Set fldr = Nothing

 

[AthenaHunter]

Cuối cùng mình đã sưu tầm và mò ra như mong đợi của minh rồi. Share cho các bạn, nếu bạn nào cần dùng thì xem đoạn code này nhe!

Dim fso, fldr
Dim iDaysold
Set fso = CreateObject("Scripting.FilesystemObject")

Set fldr = fso.GetFolder("D:\Test\Test Folder")

iDaysOld = 7

For Each subf In fldr.SubFolders

If subf.DateLastModified < (Date() - iDaysold) then

subf.Delete True

End If

Next

For Each fsofile In fldr.Files

fsofile.Delete True

Next
Set fso = Nothing
Set fldr = Nothing

a ơi...chỉ e cách nhập code này với ạ. nhập trên nền C, hay Text Documen,...

 

[YêuCN]

a ơi...chỉ e cách nhập code này với ạ. nhập trên nền C, hay Text Documen,...

Mở excel nhấn phím alt + f11 paste code vào lưu file đuôi xlsm hay xlsb ... là được còn chạy code đó bạn tìm hiểu thêm ....