Показать полную графическую версию : [решено] Удаление файлов по маске/размеру/времени изменения
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
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
Подскажите, как удалить файл, когда известно только начало имени файла.
На рабочем столе есть ярлык CheMaxRus 12.5.lnk , начало имени файла CheMaxRus - неизменно, далее цифры могут быть любыми. Нужен на vbs аналог батника:del /q "%UserProfile%\Рабочий стол\CheMaxRus*"
Попробуйте так:
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
Добрый день, тему создавать не буду, думаю эта почти подходит.
Нужен скрипт который бы удалял в конкретной папке все папки, под папки, файлы кроме тех в название которые в начале стоит знак "!"
Если в начале названия корневой папки нет знака "!" но внутри этой папки есть подпапки или файлы со знаком "!" то корневую папку удалять не надо.
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.