寻找 VBScript 将超过 3 年的文件移动到新文件夹，同时保持文件夹结构

Question

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

例如d:\share\it\test.txt -> d:\archive\share\it\test.txt，假设 test.txt 文件在 3 年内未被访问

然后我将运行对该文件夹进行磁带备份。

我有一些一直在使用的脚本。我用过的最有效的是这个，但是tt没有在测试文件夹中重新创建文件结构:

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

寻找 VBScript 将超过 3 年的文件移动到新文件夹，同时保持文件夹结构

Looking for a VBScript to move files older than 3 years to a new folder while keeping the folder structure

vbscript