Войти

Показать полную графическую версию : [решено] Удаление файлов по маске/размеру/времени изменения


nineline
09-07-2012, 16:49
Добрый день.
Сделал небольшой скрипт, который удаляет файлы в заданной папке по маске, размеру и времени изменения.
В начале скрипта указывается папка, в которой будут удалятся файлы и у меня не получается заставить его работать с несколькими папками.
Помогите пожалуйста научить скрипт брать имена папок из массива там, или из коллекции.
Скрипт корявый, собирался из нескольких примеров, т.к. сам я первый день с VBS работаю, прошу сильно не пинать.
Сам скрипт:

Public objFSO
Folder = "c:\papka"
DeathLine = 14
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(Folder) Then
Call ClrFolder(Folder)
WScript.Echo "Готово."
Else
WScript.Echo "Не найден путь " & Folder
End If
WScript.Quit 0

Function ClrFolder(strFolder)
Dim objFolder, objFile, objSubFolder
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
Datefile = objfile.DateLastModified
DiffDate = DateDiff("d",Datefile,Now)
if LCase(objFSO.GetExtensionName(File)) = "jpg" or _
LCase(objFSO.GetExtensionName(File)) = "xls" then
If DiffDate > DeathLine and _
objFile.Size > 1048576 then objFile.Delete TRUE
'Next
For Each objSubFolder In objFolder.SubFolders
Call ClrFolder(objSubFolder.Path)
Next
end if
next
end Function

Iska
09-07-2012, 19:16
arrFolders = Array("…", "…", "…")

For Each strFolder In arrFolders
If objFSO.FolderExists(Folder) Then


Next

nineline
09-07-2012, 19:56
Спасибо!
Выкладываю рабочий вариант для нужд ищущих :)
Удаляет файлы в папках folder1,folder2,folder3, которые не редактировались более 7 дней, весят более 1мб и имеют формат jpg или xls.

Public objFSO
arrFolders = Array( _
"c:\folder1", _
"c:\folder2", _
"c:\folder3")
DeathLine = 7
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each strFolder In arrFolders
If objFSO.FolderExists(strFolder) Then
Call ClrFolder(strFolder)
WScript.Echo "Папка "&strFolder&" очищена."
Else
WScript.Echo "Не найден путь " & strFolder
End If
next
WScript.Quit 0
Function ClrFolder(strFolder)
Dim objFolder, objFile, objSubFolder
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
Datefile = objfile.DateLastModified
DiffDate = DateDiff("d",Datefile,Now)
if LCase(objFSO.GetExtensionName(objFile)) = "jpg" or _
LCase(objFSO.GetExtensionName(objFile)) = "xls" then
If DiffDate > DeathLine and _
objFile.Size > 1048576 then objFile.Delete TRUE

For Each objSubFolder In objFolder.SubFolders
Call ClrFolder(objSubFolder.Path)
Next
end if
next
end Function

nineline
12-07-2012, 13:27
Немного исправил код, перенес все переменные в начало и добавил удаление пустых директорий.

Public objFSO
arrFolders = Array( _
"c:\folder1", _
"c:\folder2", _
"c:\folder3")
arrExt = Array("doc","ods","odt","txt","db","xls","jpg","gif","png",)
DeathLine=60
FileByteSize=1024
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each strFolder In arrFolders
If objFSO.FolderExists(strFolder) Then
Call DelFiles(strFolder)
Call DelEmptyFolders(strFolder)
WScript.Echo "Папка "&strFolder&" очищена."
Else
WScript.Echo "Не найден путь " & strFolder
End If
next
WScript.Quit 0

Sub DelEmptyFolders(sFldr)
Dim mDir, subDir, arDir

Set mDir = objFSO.GetFolder(sFldr)
Set subDir = mDir.SubFolders

For Each arDir In subDir
DelEmptyFolders arDir.Path
Next

If mDir.Size = 0 Then
mDir.Attributes = 0
mDir.Delete
End If
End Sub

Sub DelFiles(sFldr)
Dim mainDir, objFile, subDir,arDir
Set mainDir = objFSO.GetFolder(sFldr)
Set subDir = mainDir.SubFolders
For Each objFile In mainDir.Files
For Each arrFileExt in arrExt
Datefile = objFile.DateLastModified
DiffDate = DateDiff("d",Datefile,Now)
if LCase(objFSO.GetExtensionName(objFile)) = arrFileExt then
If DiffDate >= DeathLine and _
objFile.Size > FileByteSize then objFile.Delete TRUE
On Error Resume Next
end if
next
next
For Each arDir In subDir
DelFiles arDir.Path
Next
end Sub

BigBoo
20-09-2012, 15:02
Подскажите, как удалить файл, когда известно только начало имени файла.

На рабочем столе есть ярлык CheMaxRus 12.5.lnk , начало имени файла CheMaxRus - неизменно, далее цифры могут быть любыми. Нужен на vbs аналог батника:del /q "%UserProfile%\Рабочий стол\CheMaxRus*"

Iska
20-09-2012, 19:12
Попробуйте так:
Option Explicit

Dim objFile


With WScript.CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Pattern = "^CheMaxRus.*\.lnk$"

For Each objFile In WScript.CreateObject("Scripting.FileSystemObject").GetFolder(WScript.CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")).Files
If .Test(objFile.Name) Then
objFile.Delete
End If
Next
End With

WScript.Quit 0

ilfaty
28-05-2015, 08:36
Добрый день, тему создавать не буду, думаю эта почти подходит.
Нужен скрипт который бы удалял в конкретной папке все папки, под папки, файлы кроме тех в название которые в начале стоит знак "!"
Если в начале названия корневой папки нет знака "!" но внутри этой папки есть подпапки или файлы со знаком "!" то корневую папку удалять не надо.




© OSzone.net 2001-2012