Question

我是VBScripting的新手，完全不知道如何编写代码，但我了解VBScripting的基础知识。

我尝试使用搜索功能查找类似的情况，但它没有我需要的东西。

我很感激任何帮助，因为我的项目即将到期。

情景：

我需要删除3个月以上的jpeg文件，这些文件位于一个目录中，其中包含很多很多子文件夹。此外，目录中有4个文件夹，我不能删除或修改。

我如何手动操作是导航到映射的驱动器，到文件夹，使用窗口中的“搜索”文件夹“并输入”datemodified：2006- 01-01 ... 2013 - 08- 31"

。

然后它将显示该文件夹中的所有文件夹和子文件夹以及Excel工作表，然后我将通过仅从Type中勾选jpeg来过滤显示的列表。

代码： ' * ** * 代码开头 * ** * ** * ** *

 Option Explicit 
 On Error Resume Next 
 Dim oFSO, oFolder, sDirectoryPath 
 Dim oFileCollection, oFile, sDir 
 Dim iDaysOld

'从您要清除旧文件的位置指定目录路径

 sDirectoryPath = "C:\MyFolder"

'指定要删除的旧文件的天数

 iDaysOld = 15

 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), 4)) = "jpeg" Then

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

End If   
Next 

Set oFSO = Nothing 
enter code here`Set oFolder = Nothing 
enter code here`Set oFileCollection = Nothing 
enter code here`Set oFile = Nothing

' * ** * *** 代码结束 的 ** * ** * ****

我需要设置一个必须排除的路径+浏览子文件夹。

我想提前感谢你帮助我。

谢谢，

Answer 1

永远不要使用On Error Resume Next，除非绝对无法避免。

此问题需要递归函数。我就是这样做的：

Option Explicit

'set these constants to your requirements
Const DIR = "C:\MyFolder"
Const AGE = 15

Dim oFSO
Dim aExclude

'add to this array to exclude paths
aExclude = Array("c:\folder\exclude1", "c:\folder\another\exclude2")

Set oFSO = CreateObject("Scripting.FilesystemObject")
Call deleteFiles(oFSO.GetFolder(DIR))

Set oFSO = Nothing
WScript.Quit

'=================================
Function isExclude(sPath)
  Dim s

  For Each s in aExclude
    If LCase(s) = LCase(sPath) Then
      isExclude = True
      Exit Function
    End If
  Next

  isExclude = False
End Function

'==================================
Sub deleteFiles(fFolder)
  Dim fFile, fSubFolder

  If Not isExclude(fFolder.Path) Then
    For Each fFile in fFolder.Files
      If (LCase(Right(Cstr(fFile.Name),4)) = "jpeg") And (fFile.DateLastModified < (Date() - AGE)) Then
        'WScript.echo fFile.Path 'I put this in for testing, uncomment to do the same
        Call fFile.Delete(true)
      End If
    Next
  End If
  For Each fSubFolder in fFolder.SubFolders
    Call deleteFiles(fSubFolder)
  Next
End Sub

我真的无法完全测试它，因为我没有示例数据集，但实际上您需要做的就是设置DIR并更改aExclude数组。在运行之前确保你知道要删除的内容...

此外，它只会删除jpeg个扩展名，而不是jpg，但我想你已经知道了

Answer 2

工作解决方案（Jobbo几乎让它以通用形式工作）：

更新：包括日志文件写入，跳过文件夹数量和删除文件。

Option Explicit

'set these constants to your requirements
Const DIR = "C:\Test"
Const LOGFILE = "C:\Log.txt" ' Location of Log file
Const MAX_AGE = 3 ' Unit: Months
Const FILEEXT = "jpeg"

Dim oFSO
Dim oLogFile
Dim aExclude
Dim lngDeletes, lngSkips

'add to this array to exclude paths
aExclude = Array("c:\Test\test 1", "c:\Test\test 2\test")

Set oFSO = CreateObject("Scripting.FilesystemObject")
Set oLogFile = oFSO.createtextfile(LOGFILE)
lngDeletes = 0
lngSkips = 0
LOGG "Script Start time: " & Now
LOGG "Root Folder: " & DIR
LOGG String(50, "-")

deleteFiles oFSO.GetFolder(DIR)

LOGG String(50, "-")
LOGG lngDeletes & " files are deleted"
LOGG lngSkips & " folders skipped"
LOGG "Script End time: " & Now
oLogFile.Close
Set oLogFile = Nothing
Set oFSO = Nothing
MsgBox "Logfile: """ & LOGFILE & """", vbInformation, wscript.scriptName & " Completed at " & Now
wscript.Quit

'=================================
Sub LOGG(sText)
    oLogFile.writeline sText
End Sub
'=================================
Function isExclude(sPath)
    Dim s, bAns
    bAns = False
    For Each s In aExclude
        If InStr(1, sPath, s, vbTextCompare) = 1 Then
            bAns = True
            Exit For
        End If
    Next
    isExclude = bAns
End Function
'=================================
Function isOldFile(fFile)
    ' Old file if "MAX_AGE" months before today is greater than the file modification time
    isOldFile = (DateAdd("m", -MAX_AGE, Date) > fFile.DateLastModified)
End Function
'==================================
Function isFileJPEG(fFile)
    Dim sFileName
    sFileName = fFile.Name
    ' Mid(sFileName, InStrRev(sFileName, ".")) gives you the extension with the "."
    isFileJPEG = (LCase(Mid(sFileName, InStrRev(sFileName, ".") + 1)) = FILEEXT)
End Function
'==================================
Sub deleteFiles(fFolder)
    Dim fFile, fSubFolder
    If Not isExclude(fFolder.Path) Then
        'WScript.echo "==>> """ & fFolder.Path & """" ' Comment for no output
        For Each fFile In fFolder.Files
            If isFileJPEG(fFile) And isOldFile(fFile) Then
                lngDeletes = lngDeletes + 1
                LOGG lngDeletes & vbTab & fFile.Path
                'WScript.echo vbTab & "DELETE: """ & fFile.Path & """" ' Comment for no output
                fFile.Delete True ' Uncomment to really delete the file
            End If
        Next
        ' Only Process sub folders if current folder is not excluded
        For Each fSubFolder In fFolder.SubFolders
            deleteFiles fSubFolder
        Next
    Else
        lngSkips = lngSkips + 1
        'WScript.echo "<<-- """ & fFolder.Path & """" ' Comment for no output
    End If
End Sub

Output

VBScript从文件夹中删除项目

2 个答案: