寻找VBScript将3年以上的文件移动到新文件夹，同时保留文件夹结构

Question

我希望将文件从文件服务器移动到磁带机以节省空间。我需要一个脚本，允许我移动3年前或之后访问的所有文件，同时仍保留其文件夹结构。

E.g。 d：\ share \ it \ test.txt - ＆gt; d：\ archive \ share \ it \ test.txt，假设3年内未访问test.txt文件

然后我将在此文件夹上运行磁带备份。

我有一些我一直在使用的脚本。我使用过的最有效的是这个，但是tt不会在test文件夹中重新创建文件结构：

Dim objFSO, ofolder, objStream, strSafeDate, strSafeTime, strDateTime, strLogFileName

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objNet = CreateObject("WScript.NetWork")
Set FSO = CreateObject("Scripting.FileSystemObject")

strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)

Set strDateTime equal to a string representation of the current date and time, for use as part of a valid Windows filename

strDateTime = strSafeDate & "-" & strSafeTime

'Assemble the path and filename
strLogFileName ="Move File " & strDateTime & ".txt"
set outfile = fso.createtextfile(strLogFileName,true)
SPath = "I:\Tech Docs"
Sdest = "I:\Test\"

ShowSubfolders FSO.GetFolder(spath)

Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        CheckFolder(subfolder)
        ShowSubFolders Subfolder
    Next
End Sub

'CheckFolder(objFSO.getFolder(SPath))

Sub CheckFolder(objCurrentFolder)
    Dim strTempL, strTempR, strSearchL, strSearchR, objNewFolder, objFile
    Const OverwriteExisting = TRUE
    currDate = Date
    dtmDate = DateAdd("d",-0,Now)
    strTargetDate = ConvDate(dtmDate)
    For Each objFile In objCurrentFolder.Files
        FileName = objFile
        'WScript.Echo FileName
        'strDate = ConvDate(objFile.DateCreated)
        strDate = ConvDate(objFile.DateLastAccessed)
        If strDate < strTargetDate Then
            objFSO.MoveFile FileName, Sdest
            outfile.writeline Filename
        End If
    Next
End Sub

Function ConvDate (sDate) 'Converts MM/DD/YYYY HH:MM:SS to string YYYYMMDD
    strModifyDay = day(sDate)
    If len(strModifyDay) < 2 Then
        strModifyDay = "0" & strModifyDay
    End If
    strModifyMonth = Month(sDate)
    If len(strModifyMonth) < 2 Then
        strModifyMonth = "0" & strModifyMonth
    End If
    strModifyYear = Year(sDate)
    ConvDate = strModifyYear & strModifyMonth & strModifyDay
End Function
    `

Answer 1

Dim objFSO, ofolder, objStream, strSafeDate, strSafeTime, strDateTime, strLogFileName

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objNet = CreateObject("WScript.NetWork")
Set FSO = CreateObject("Scripting.FileSystemObject")

strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)

Set strDateTime equal to a string representation of the current date and time, for use as part of a valid Windows filename

strDateTime = strSafeDate & "-" & strSafeTime

'Assemble the path and filename
strLogFileName ="Move File " & strDateTime & ".txt"
set outfile = fso.createtextfile(strLogFileName,true)
SPath = "I:\Tech Docs\"
Sdest = "I:\Test\"

ShowSubfolders FSO.GetFolder(spath)

Sub ShowSubFolders(Folder)
    CheckFolder Folder
    For Each Subfolder in Folder.SubFolders
        ShowSubFolders Subfolder
    Next
End Sub

'CheckFolder(objFSO.getFolder(SPath))

Sub CheckFolder(objCurrentFolder)
    Dim strTempL, strTempR, strSearchL, strSearchR, objNewFolder, objFile
    Const OverwriteExisting = TRUE
    currDate = Date
    dtmDate = DateAdd("d",-0,Now)
    strTargetDate = ConvDate(dtmDate)
    For Each objFile In objCurrentFolder.Files

        'Since we want to preserve the path, we've got to reconstruct it
        sAbsPath = objFile.Path
        'Swap source and destination in the path, and strip the file name
        'from the path.
        sNewPath = Replace(Replace(sAbsPath,sPath,Sdest),"\" & objFile.Name,"")
        'Here we reconstruct the path if it doesn't exist in the
        'destination with our new Sub "MakeDir"
        MakeDir sNewPath

        FileName = objFile
        'WScript.Echo FileName
        'strDate = ConvDate(objFile.DateCreated)
        strDate = ConvDate(objFile.DateLastAccessed)
        If strDate =< strTargetDate Then
            'Finally we copy the file to the sNewPath
            objFSO.MoveFile FileName, sNewPath & "\"
            outfile.writeline Filename
        End If
    Next
End Sub

Sub MakeDir(strPath)
    On Error Resume Next
        strParentPath = objFSO.GetParentFolderName(strPath)

        If Not objFSO.FolderExists(strParentPath) Then MakeDir strParentPath
        If Not objFSO.FolderExists(strPath) Then objFSO.CreateFolder strPath
    On Error Goto 0 
End Sub

Function ConvDate (sDate) 'Converts MM/DD/YYYY HH:MM:SS to string YYYYMMDD
    strModifyDay = day(sDate)
    If len(strModifyDay) < 2 Then
        strModifyDay = "0" & strModifyDay
    End If
    strModifyMonth = Month(sDate)
    If len(strModifyMonth) < 2 Then
        strModifyMonth = "0" & strModifyMonth
    End If
    strModifyYear = Year(sDate)
    ConvDate = strModifyYear & strModifyMonth & strModifyDay
End Function