By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
440,091 Members | 1,555 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 440,091 IT Pros & Developers. It's quick & easy.

Script to move files older than x days old

P: 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
Nov 27 '07 #1
Share this Question
Share on Google+
3 Replies


Dököll
Expert 100+
P: 2,364
Found a little VB Script that looks like it does just that. Have not tried it but do give it a whirl:

Expand|Select|Wrap|Line Numbers
  1.  
  2. Dim SOURCE, TARGET
  3. SOURCE = "c:\logs"
  4. TARGET = "c:\oldlogs\"
  5.  
  6. Dim fso, SourceObj, TargetObj, fileObj
  7. Set fso = CreateObject("Scripting.FileSystemObject")
  8. Set SourceObj = fso.GetFolder(SOURCE)
  9.  
  10. For Each fileObj in SourceObj.Files
  11. If LCase(Right(fileObj.Name, 4)) = ".log" Then
  12. If DateDiff("d", fileObj.DateLastModified, Now) > 7 Then
  13. fileObj.Move (TARGET)
  14. End If
  15. End If
  16. Next
  17.  
  18.  
Let us know if this worked or not.

Have fun!
Nov 30 '07 #2

P: 20
i changed to not look at only files that have .log extension.

I'm not sure if this will scan every folder on a sharedrive? It worked when I put in a specific folder, but I'm not sure if it'll do every file if i just put in the drive(i.e. "C:\" as the source.
Nov 30 '07 #3

P: 20
This gets the files at the root of the folder but does not actually go into the other folders that are on the drive and move those files that meet the days criteria. Any suggestions?
Dec 5 '07 #4

Post your reply

Sign in to post your reply or Sign up for a free account.