vbscript - VBSを使用して作成日の範囲でファイルをコピーします（サブフォルダーファイルにも）

Question

このリンクを 使用して、指定された日付範囲内でファイルをコピーしようとしまし たが、ルート ディレクトリのみをコピーできます。誰か助けてください。

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