使用 VBS 复制具有创建日期范围的文件（也在子文件夹文件中）

Question

我试过这个链接 copy files between a specified date range 但我只能复制根目录 请任何人帮助我

Answer 1

给你。请注意，这可能会创建空目录，因为它将创建一个目录，然后检查每个文件是否在指定的日期范围内。如果没有文件，目录将保持为空。

显然，您可以注释掉或删除 WScript.Echo 行。它们仅用于故障排除。

Option Explicit
dim objFSO, strSource, strTarget

set objFSO = CreateObject("Scripting.FileSystemObject")
strSource = "c:\Folder1\"
strTarget = "c:\Copy of Folder1\"

call RecurseCopy(strSource, strTarget, True, #04/15/2012 00:00:01 AM#, #04/16/2012 00:00:01 AM#)

' // Recursively copy all files and folders
Sub RecurseCopy(strSource, strTarget, blnCopySubfolders, dBeginDate, dEndDate)
    dim objSource, objTarget

    WScript.Echo "Begin RecurseCopy" & vbcrlf & vbcrlf & _
            "strSource: " & strSource & vbcrlf & _
                "strTarget: " & strTarget

    set objSource = objFSO.GetFolder(strSource)

    If objFSO.FolderExists(strTarget) = False Then
        Wscript.Echo "Now going to create folder: " & strTarget
        objFSO.CreateFolder(strTarget)
    End If

    set objTarget = objFSO.GetFolder(strTarget)

    Dim file
    for each file in objSource.files
        If file.DateCreated => dBeginDate AND file.DateCreated =< dEndDate Then
            Wscript.Echo "Copying file: " & file.path & " to " & objTarget.Path
            file.Copy objTarget.Path & "\" & file.name
        Else
            WScript.Echo "File will not be copied because the DateCreated is not within the specified range." & vbcrlf & vbcrlf & _
                        File.Path & " " & file.DateCreated
        End If
    next

    If blnCopySubfolders = True Then
        ' ** For each subfolder of current dir, copy files to target and recurse its subdirs
        Dim subdir
        for each subdir in objSource.subfolders
            call RecurseCopy(objSource.Path & "\" & subdir.Name, objTarget.Path & "\" & subdir.Name, True, dBeginDate, dEndDate)
        Next
    End If

End Sub