Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)
-   -   [решено] Удаление файлов по маске/размеру/времени изменения (http://forum.oszone.net/showthread.php?t=238232)

nineline 09-07-2012 16:49 1948750

Удаление файлов по маске/размеру/времени изменения
 
Добрый день.
Сделал небольшой скрипт, который удаляет файлы в заданной папке по маске, размеру и времени изменения.
В начале скрипта указывается папка, в которой будут удалятся файлы и у меня не получается заставить его работать с несколькими папками.
Помогите пожалуйста научить скрипт брать имена папок из массива там, или из коллекции.
Скрипт корявый, собирался из нескольких примеров, т.к. сам я первый день с 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 1948822

Код:

arrFolders = Array("…", "…", "…")

For Each strFolder In arrFolders

    If objFSO.FolderExists(Folder) Then
    …
    …
Next


nineline 09-07-2012 19:56 1948857

Спасибо!
Выкладываю рабочий вариант для нужд ищущих :)
Удаляет файлы в папках 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 1950570

Немного исправил код, перенес все переменные в начало и добавил удаление пустых директорий.
Код:

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 1992052

Подскажите, как удалить файл, когда известно только начало имени файла.

На рабочем столе есть ярлык CheMaxRus 12.5.lnk , начало имени файла CheMaxRus - неизменно, далее цифры могут быть любыми. Нужен на vbs аналог батника:
Код:

del /q "%UserProfile%\Рабочий стол\CheMaxRus*"

Iska 20-09-2012 19:12 1992188

Попробуйте так:
Код:

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 2512184

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


Время: 04:02.

Время: 04:02.
© OSzone.net 2001-