0

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

我尝试使用搜索功能来查找与我类似的案例，但它没有我需要的。

我非常感谢任何帮助，因为我的项目即将到期。

设想：

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

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

然后它将显示该文件夹中的所有文件夹和子文件夹以及 excel 表，然后我将通过仅从类型中勾选 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

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

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

我想提前感谢你帮助我。

谢谢，

4

2 回答 2

0

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但我想你已经知道了

于 2013-11-11T08:02:02.183 回答
0

工作解决方案（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

输出

于 2013-11-18T06:26:10.643 回答