Т.к. сам с Воронежа, поэтому взял патриотизм и решил написать здесь, чем где то еще.
Воронежские программисты лучшие программисты страны
Итак, я отвлекся.
А речь пойдет вот о чём:
Появилась задача очистки каталогов от устаревших файлов.
Общий ресурс на сервере.
Структура вида:
Change
- IT-отдел
- Экономический отдел
- Отдел кадров
- Директор
В каждом отделе пользуны хранят непойми что. Так как в отделе могут находится бесчисленное множество вложенных подкаталогов, необходимо использовать рекурсию.
Ниже код на VBS:
Код: Выделить всё
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "d:\Test\" 'папка которую очищаем
arrPath =array("d:\Test\","d:\Test\Test1","d:\Test\Test2","d:\Test\Test3") 'не удаляемые папки (содержимое удалится)
On Error Resume Next
Const Age = 10 'возраст файла
Set objFolder = objFSO.GetFolder(objstartfolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If DateDiff("D", objFile.DateLastModified, Now) > Age Then ' проверка файлов на старость
Log (objFolder.Path & "\" & objFile.Name & " - " & objFile.DateLastModified)
objFile.Attributes = 0
objFile.Delete
End If
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Set objFolder = objFSO.GetFolder(subfolder.Path)
p=false
i=lbound(arrPath)
WHILE (p=false) and (i<=ubound(arrPath))
If (objfolder.path=arrPath(i) ) then
p=true
End if
i=i+1
WEND
If (not p) Then
'Wscript.Echo objfolder.path & " - " & "udalat` mozna"
' 1) проверить файлы на старость
Set colFiles = objFolder.Files
For Each objFile in colFiles
If DateDiff("D", objFile.DateLastModified, Now) > Age Then ' проверка файлов на старость
Log (objFolder.Path & "\" & objFile.Name & " - " & objFile.DateLastModified)
objFile.Attributes = 0
objFile.Delete
End If
Next
' 2) проверить каталог на пустоту
If objFolder.Subfolders.Count > 0 Then
ShowSubFolders SubFolder
End If
If subFolder.Files.Count > 0 AND subFolder.Subfolders.Count > 0 Then
WScrip.echo "test"
'MsgBox "Directory " & subFolder & "- ne pusta."
Else
Log(subFolder.Path & " - " & subFolder.Datecreated)
objFSO.DeleteFolder(subFolder.Path)
End If
End If
Next
End Sub
'функция для создания log-файла. он создается рядом со скриптом, имя - дата запуска скрипта.
Function Log(strLineToLog)
Const ForReading = 1, ForWriting = 2
Dim fso, f, FileLog
Set fso = CreateObject("Scripting.FileSystemObject")
FileLog = Left(WScript.ScriptName,(Len(WScript.ScriptName)-4)) & "_" & DatePart("yyyy",Date) & "_" & DatePart("m",Date) & "_" & DatePart("d",Date) & "." & "log"
Set f = fso.OpenTextFile(FileLog, 8, True)
f.Write strLineToLog & vbCrLf
f.Close
End Function
Если папка пуста, то удаляем папку и не важно когда она была создана. Папки исключения (названия отделов и корень) НЕ удаляем в любом случае.
Если подпапка не пуста (в ней новый файл), то такая подпапка НЕ удаляется вне зависимости от даты создания папки.
Проблема с этим скриптом в том, что он корректно срабатывает только в корне при операциях с файлами.
Папки (в том числе и исключения!) он трет, даже если в них лежит свежий файл..
Помогите найти косяки в коде.
Заранее благодарен