20
I was wandering if nyone has a script to move files older than x days old? i've seen several to delete, but I don't want to delete. I would like to create a backup of the files first verify with users if it's ok to delete.
Thanks in advance. i found one that was really close but it only looks at one folder. I need it to look at files within folders and subfolders too.
Dim oFSO, wshShell, FileCol, oFolder, objTextFile, shareLength, strDeptShare, strFileName, folderArray, i, message
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject("WScript.Shell")
Set wshNetwork = WScript.CreateObject("WScript.Network")
'==========
'**** Configurable script options ****
'==========
'Location to search for files to archive from
'defaultShare = "J:\DeptShares"
defaultShare = "C:\AcornTraining"
'Location to move files to
'defaultPath = "\\servername\archive_share"
defaultPath = "C:\archives"
'Script searches for files older than this date
'defaultDate = "01/01/2000"
defaultDate = "11/27/2005"
'Move files from these folders only
'folderArray = array("InfoShared", "ISShared", "ISEngineering", "ISMgr", "ISOperations")
'==========
'*********** Script begins ***********
'==========
shareName = inputbox("Please type the path to the file share you wish to search" & _
vbCrLf & "Leave this box empty for default path below:" & _
vbCrLf & defaultShare)
if shareName = "" then
shareName = defaultShare
end if
shareLength = len(shareName)
checkDate = inputbox("Please put in the date from which we are checking for modify date" & _
vbCrLf & "Leave this box empty for the default date below:" & _
vbCrLf & defaultDate)
if checkDate = "" then
checkDate = defaultDate
end if
daysSinceCheckDate = datediff("d", checkDate, date)
strMoveFileLocation = inputbox("Please type the path to place archived files and the file report" & _
vbCrLf & "Leave this box empty for the default path below:" & _
vbCrLf & defaultPath)
if strMoveFileLocation = "" then
strMoveFileLocation = defaultPath
end if
FileDIr = strMoveFileLocation & "\Files"
if not oFSO.FolderExists(FileDir) then
oFSO.CreateFolder(FileDir)
end if
'Error handling
on error resume next
logFile = strMoveFileLocation & "\" & "FileReport.csv"
tempFile = strMoveFileLocation & "\" & "tempfile.txt"
errorFile = strMoveFileLocation & "\" & "errors.txt"
if oFSO.FileExists(tempFile) then
oFSO.DeleteFile tempFile
end if
if not oFSO.FolderExists(shareName) then
wscript.echo "invalid start folder location"
wscript.quit
end if
if not oFSO.FolderExists(strMoveFileLocation) then
wscript.echo "invalid archive folder location"
wscript.quit
end if
set oFolder = oFSO.GetFolder(shareName)
Set colSubfolders = oFolder.Subfolders
strPreviousDeptShare = ""
strUserCount = "0"
'This message writes the column headers to the .csv file
message = "File Path " & "," & "File Name" & "," & "File type" & "," & _
"File Size (Bytes)" & "," & "File Age (Days)" & "," & _
"Date last accessed" & "," & "Date last modified"
writeLog logFile, message
'This calls the main subroutine
ShowFolders(oFolder)
wshShell.run "explorer.exe " & strMoveFileLocation
wscript.echo "Done!"
wscript.quit
'==========
'*********** Subroutines *************
'==========
Sub ShowFolders(Folder)
For Each Subfolder in Folder.SubFolders
'continue = 0
'Find out if the current subfolder is in the array of folders to search
'for i = 0 to uBound(folderArray)
'if subfolder.name = folderArray(i) then
' continue = 1
'end if
'next
'if continue = 1 then
set osubfolder = oFSO.GetFolder(Subfolder.Path)
on error goto 0 'Change error num back to 0
set FileCol = osubFolder.Files
for each fil in filecol
fileModifyDate = fil.DateLastModified
daysSinceModify = datediff("d", fileModifyDate, date)
'Move file only if it is older than modify date specified
if daysSinceModify > daysSinceCheckDate then
fileAge = datediff("d", fil.DateCreated, date)
fileLastAccess = fil.DateLastAccessed
'fileSizeMB = FormatNumber(fil.size/1048576, 0)
message = fil.path & "," & fil.name & "," & fil.type & "," & fil.size & "," & fileAge & "," & _
fileLastAccess & "," & fileModifyDate
writeLog logFile, message
fileNameLength = len(fil.name)
filePathLength = len(fil.path)
filePathDiff = filePathLength - (fileNameLength)
filePath = left(fil.path, filePathDiff)
fileFolderLength = filePathDiff - shareLength
fileFolderPath = right(filePath, fileFolderLength)
newFilePath = FileDir & fileFolderPath
'Make sure subfolder exists in new location, create if necessary
if not oFSO.FolderExists(newFilePath) then
oFSO.CreateFolder(newFilePath)
end if
fil.Move(newFilePath)
end if
next
'Start subroutine again for each subfolder in folders collection
ShowSubFolders Subfolder
'An error here indicates permissions problem, log to error file
if err.number <> 0 then
writeLog errorFile, subfolder.path
end if
on error goto 0 'Change error num back to 0
'end if
Next
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
set osubfolder = oFSO.GetFolder(Subfolder.Path)
if err.number <> 0 then
writeLog errorFile, subfolder.path
end if
on error goto 0 'Change error num back to 0
set FileCol = osubFolder.Files
for each fil in filecol
fileModifyDate = fil.DateLastModified
daysSinceModify = datediff("d", fileModifyDate, date)
'Move file only if it is older than modify date specified
if daysSinceModify > daysSinceCheckDate then
fileAge = datediff("d", fil.DateCreated, date)
fileLastAccess = fil.DateLastAccessed
'fileSizeMB = FormatNumber(fil.size/1048576, 0)
message = fil.path & "," & fil.name & "," & fil.type & "," & fil.size & "," & fileAge & "," & _
fileLastAccess & "," & fileModifyDate
writeLog logFile, message
fileNameLength = len(fil.name)
filePathLength = len(fil.path)
filePathDiff = filePathLength - fileNameLength
filePath = left(fil.path, filePathDiff)
fileFolderLength = filePathDiff - shareLength
fileFolderPath = right(filePath, fileFolderLength)
newFilePath = FileDir & fileFolderPath
'Make sure subfolder exists in new location, create if necessary
if not oFSO.FolderExists(newFilePath) then
oFSO.CreateFolder(newFilePath)
'An error will occur if the parent folder of the folder being created
'does not exist. The script will now create missing folder tree
if err.number <> 0 then
on error goto 0 'Change error num back to 0
continueLooping = 1
strTempLoopDir = fileDir & "\"
Do while continueLooping = 1
shareLength = len(strTempLoopDir)
writeLog tempFile, newFilePath
Set objTextFile = oFSO.OpenTextFile(tempFile, 1, True)
Do while objTextFile.AtEndofStream <> True
if firstLoop <> "1" then
objTextFile.Skip(shareLength)
firstLoop = "1"
end if
strChar = objTextFile.Read(1)
if strChar <> "\" then
strShareFolderPath = strShareFolderPath + strChar
else exit do
end if
Loop
objTextFile.Close
if oFSO.FileExists(tempFile) then
oFSO.DeleteFile tempFile
end if
strLoopPath = strTempLoopDir & strShareFolderPath & "\"
if not oFSO.FolderExists(strLoopPath) then
'Create next folder folder tree
oFSO.CreateFolder(strLoopPath)
if strLoopPath = newFilePath then
'Folder tree has been built
continueLooping = 0
end if
end if
strTempLoopDir = strLoopPath
firstLoop = 0
strShareFolderPath = ""
Loop
shareLength = len(shareName)
end if
end if
'Move file to new location
fil.Move(newFilePath)
end if
next
'Start subroutine again with next subfolder in collection
ShowSubFolders Subfolder
'An error here indicates permissions problem, log to error file
if err.number <> 0 then
writeLog errorFile, subfolder.path
end if
on error goto 0 'Change error num back to 0
Next
End Sub
Sub writeLog(strLogFile, strMessage)
const ForRead = 1
const ForWrite = 2
const ForAppend = 8
Set fsLog = oFSO.OpenTextFile(strLogFile, 8, True)
fsLog.WriteLine (strMessage)
fsLog.Close
End Sub
