'******************************************************************************
'
'FileArchive.vbs v1.0
'
'Archive Files last accessed on date strDate as specified by admins
'
'Created by k_quaid
'
'script takes the details and archives all files last accessed before strDate
'from the folder strFolder and moves the files into strArchive in the same
'folder structure
'it also leaves a shortcut in the place of the original linking it to the
'archived file
'******************************************************************************
Const FOR_READING = 1
Dim strDate,strFolder,strArchive,Archfolder
Dim objFSO,objFolder,OutPutFile,FileSystem,errlog
'*******************************************************************
'Section to be Edited before running script
'Set the last Accessed date for archiving
'Location of Files to scan
'Location of Archive folder (doesnt have to exist)
'*******************************************************************
strDate = CDate(DateAdd("m",-6,Now()))
strFolder = "D:\folder\location\that\needs\archiving"
'strfilehome = "
file://homeserver/"
strArchive = "
file://newserver/Archive"
'*******************************************************************
intLastaccessFiles = 0
intLastaccessSize = 0
TotalFiles = 0
TotalSize = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set OutPutFile = FileSystem.CreateTextFile("filedetails.txt", True)
Set errlog = FileSystem.CreateTextFile("error.txt", True)
Set iconlog = FileSystem.CreateTextFile("icon.txt", True)
Set colFiles = objFolder.Files
On error resume next
For Each objFile In colFiles
TotalFiles = TotalFiles + 1
TotalSize = TotalSize + objFile.Size
If objFile.DateLastAccessed < strDate Then
OutPutFile.WriteLine objFile.path & vbTab & objFile.Name & vbTab & objFile.DateLastAccessed & vbTab & strDate
filepath = objFile.Path
filedrive = Ucase(objFile.Drive)
filename = objFile.Name
fileloc = Replace(filepath,filedrive,"")
filefolder = Replace(fileloc,filename,"")
Archfolder = strArchive & filefolder
CreateFolder( Archfolder )
CreateIcon( objfile )
objFSO.MoveFile filepath, Archfolder
intLastaccessFiles = intLastaccessFiles + 1
intLastaccessSize = intLastaccessSize + objFile.Size
If Err.Number <> 0 Then
errlog.WriteLine Err.Description & vbTab & objFile.Name & vbTab & Err.Number
End if
End if
Next
ShowSubFolders(objFolder)
OutPutFile.WriteLine "************************************************************************************"
OutPutFile.WriteLine "************************************************************************************"
OutPutFile.WriteLine "Directory Scanned : " & (strfolder)
OutPutFile.WriteLine "Total files Last accessed: " & (intLastaccessFiles) & " before " & strdate
OutPutFile.WriteLine "Total size of files Last accessed: " & (intLastaccessSize) & " before " & strdate
OutPutFile.WriteLine "Total files: " & (TotalFiles)
OutPutFile.WriteLine "Total size of files: " & (TotalSize)
OutPutFile.WriteLine "************************************************************************************"
OutPutFile.WriteLine "************************************************************************************"
OutPutFile.Close
Set FileSystem = Nothing
WScript.Echo "Finished"
WScript.Quit(0)
Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
On error resume next
For Each objSubFolder In colFolders
' OutPutFile.WriteLine objSubFolder.Path
Set colFiles = objSubFolder.Files
For Each objFile In colFiles
TotalFiles = TotalFiles + 1
TotalSize = TotalSize + objFile.Size
If objFile.DateLastAccessed < strDate Then
OutPutFile.WriteLine objFile.path & vbTab & objFile.Name & vbTab & objFile.DateLastAccessed & vbTab & strDate
filepath = objFile.Path
filedrive = Ucase(objFile.Drive)
filename = objFile.Name
fileloc = Replace(filepath,filedrive,"")
filefolder = Replace(fileloc,filename,"")
Archfolder = strArchive & filefolder
CreateFolder( Archfolder )
CreateIcon( objfile )
objFSO.MoveFile filepath, Archfolder
intLastaccessFiles = intLastaccessFiles + 1
intLastaccessSize = intLastaccessSize + objFile.Size
If Err.Number <> 0 Then
errlog.WriteLine Err.Description & vbTab & objFile.Name & vbTab & Err.Number
End if
End if
Next
ShowSubFolders(objSubFolder)
Next
End Sub
Sub CreateFolder( Archfolder )
On Error Resume Next
If Archfolder <> "" Then 'Fixes endless recursion in some instances when at lowest directory
If Not objFSO.FolderExists( objFSO.GetParentFolderName(Archfolder) ) then Call CreateFolder( objFSO.GetParentFolderName(Archfolder) )
objFSO.CreateFolder( Archfolder )
End If
End Sub
Sub CreateIcon( objfile )
filepath = objFile.Path
filedrive = Ucase(objFile.Drive)
filename = objFile.Name
fileloc = Replace(filepath,filedrive,"")
filefolder = Replace(fileloc,filename,"")
On Error Resume Next
Iconlog.WriteLine strArchive & filefolder & filename
strIconPath = filepath & ".lnk"
Set WshShell = CreateObject("WScript.Shell")
Set objShortcutUrl = WshShell.CreateShortcut(striconPath)
objShortcutUrl.TargetPath = strArchive & filefolder & filename
objShortcutUrl.IconLocation = "C:\WINDOWS\system32\dllcache\inetmgr.dll,5"
If Err.Number <> 0 Then
errlog.WriteLine Err.Description & vbTab & objFile.Name & vbTab & Err.Number
End if
objShortcutUrl.Save
End Sub