VBS Script to Archive Files

VBS Script to Archive Files.vbs

'This takes 2 paths, one to monitor and one to create archives in.  
'Running it creates folders by day and archives files it finds by the date.created.  A few tweaks could make that date.modified.
'
' SCRIPT FUNCTION
'    To process daily report files into organized daily folders based on date created
' CREATED ON/BY
'	Kevin Guyer 2008


OPTION EXPLICIT
' --------------------------------------------------
' DECLARE PATHS
' Change these accordingly.  Their functions follow
	'folderToMonitor is where the script looks for stray files needing placed in archive folders
		const folderToMonitor = "d:\test\files\"
	'targetFolderHome is the root where the script will create new archive folders and move your files to
		const targetFolderHome = "d:\test\files\archives\"
		
' --------------------------------------------------
' STEP :: Loop through files

	' We call a sub to do this:
		walkFilesInFolder folderToMonitor
	
' --------------------------------------------------	
' SUB :: look at all files, create folders and move as needed

	sub walkFilesInFolder(path)
	 
		dim fs, folder, file, item, thisFileCreatedDate
	    set fs = CreateObject("Scripting.FileSystemObject")
	    set folder = fs.GetFolder(path)
	 
		for each item in folder.Files
' STEP :: Found a file, extract created date and pad with zeroes as needed
			thisFileCreatedDate = year(item.DateCreated) 
			if month(item.DateCreated) < 10 then
				thisFileCreatedDate = thisFileCreatedDate & "0"
			end if
			thisFileCreatedDate = thisFileCreatedDate & month(item.DateCreated) 
			
			if day(item.DateCreated) < 10 then
				thisFileCreatedDate = thisFileCreatedDate & "0"
			end if				
			thisFileCreatedDate = thisFileCreatedDate & day(item.DateCreated)
			
' STEP :: Check for existence of a matching folder name and call appropriate function				
			' Call sub that creates a folder if needed, does nothing if it exists
				insureFolderForDate thisFileCreatedDate
				
' STEP :: Move file to it's matching dated folder					
			' Now that we know that a folder exists, move this file there					
				dim objFSO, objFileCopy, fullMovePath, objFileMover 
				Set objFSO = CreateObject("Scripting.FileSystemObject")
				Set objFileMover = objFSO.GetFile(item.path)
				fullMovePath = targetFolderHome & thisFileCreatedDate & "\" & item.name
				objFileMover.Move (fullMovePath)
				
				'Clean up
					set objFSO = Nothing
					set objFileMover = Nothing
					set fullMovePath = Nothing
					set objFileMover = Nothing
' STEP :: Repeat loop					
		next	
	end sub

' --------------------------------------------------

' SUB :: Create folder with date
	sub insureFolderForDate(dateNeeded)
		' If the folder does not exist we now create it
			dim objFSO, objNewFolder 
			set objFSO = CreateObject("Scripting.FileSystemObject")
			if not objFSO.FolderExists(targetFolderHome & dateNeeded) then
				set objNewFolder = objFSO.CreateFolder(targetFolderHome & dateNeeded)
			end if
			
			' Clean up
				set	objFSO = Nothing
				set objNewFolder = Nothing
	end sub