我尝试使用此链接 在指定日期范围之间复制文件, 但我只能复制根目录,请任何人帮助我
问问题
9542 次
1 回答
3
干得好。请注意,这可能会创建空目录,因为它将创建一个目录,然后检查每个文件是否在指定的日期范围内。如果没有文件,则目录将保持为空。
显然,您可以注释掉或删除 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
于 2012-04-18T13:28:33.260 回答