asked on

VBA or PowerShell Script to Move files into Year folders keeping existing folder structure, so that we can archive later

We are trying to sort our data into years so that we can start archiving the old data off the servers.
You will only need to complete the main question (with point 1 below) to my satisfaction to get an A grade, points 2 and 3 would be fantastic though and would help me out a lot.

Main Question:
How can I check recursively through sub-folders and, *based on the existing folders* name/structure, recreate *the same folder structure* under a new 'year' folder and move the file based on the date the file was created? (See example below).

I would like to define at the top of the script:

1. The base folder as the top level, all sub-folders would be processed (nb, there may be spaces in the path)

2. The maximum year as a variable so that, for example, if we set the MaxYear = 2007 then it would only perform the action on files that were in or before 2007, and to continue the example would leave 2008 and newer files in their current location.

3. If it should file under calendar years (eg, 1 Jan - 31 Dec) or tax years (eg, our 2008 tax year goes between 1 July 2007 and 30 June 2008). Perhaps this would most easily be managed by having 2 variables "startDay" and "startMonth", of which the script could determine the end dates.

I'm a real beginner with this, so please spell it out much a possible :)

Thanks!

_________________________
PS, running on Windows 2000

Example Structure (I've added the year created in brackets):
 
### FILE STRUCTURE BEFORE SCRIPT ###
C:\Data\ may contain:
 |_ Client1
    |_ Folder1
       |_ MyText1.doc (2005)
       |_ MySpreadsheet1.xls (2006)
    |_ Folder2
       |_ Folder3
           |_ MyText3.doc (2005)
       |_ MyText2.doc (2006)
       |_ MySpreadsheet2.xls (2007)
    |_ Mytext0.doc (2007)
    |_ MySpreadsheet0.xls (2006)
 |_Client2...
#####################################
 
 
Running the script & pointing it to the C:\Data\ folder would create:
 
 
### FILE STRUCTURE AFTER SCRIPT ###
C:\Data\
 |_ Client1
    |_ 2005
        |_ Folder1
            |_ MyText1.doc (2005)
        |_ Folder2
            |_ Folder3
                |_ MyText3.doc (2005)
    |_ 2006
        |_ Folder1
            |_ MySpreadsheet1.xls (2006)
        |_ Folder2
            |_ MyText2.doc (2006)
    |_ 2007
        |_ Folder2
            |_ MySpreadsheet2.xls (2007)
        |_ Mytext0.doc (2007)
 |_ Client2...
###################################

Open in new window

ltlbearand3

Gamm,

You stated you wanted vba or powershell, but you have this in vbscript. So I dont know what you really want. I have put a vbscript routine together for you that should handle your requirements. If you want this in VBA, you will need to change the declare statements to put the variable type (i.e. dim strMainDir as String).

You can cut and paste the code, adjust the variables and save in a file with a .vbs extension. You can then run this script. Please test this on a backup type machine before trying on your real data!

Let me know if you have questions.

-Bear

' VB Script to Categorize Files by Date
 
' Declare Variables
Dim strMainDir, lngMaxYear, intStartMonth
Dim objFSO, objFolder, objFiles, objFile
Dim objSubfolder, intYear, intMonth, strNewPath
 
' *******************************************
' *******************************************
' Set Variables that drive behavior
strMainDir = "C:\Data"	' Main Directory to be categorized
intMaxYear = 2008			' Do Not Categorize Files NEWER than this year
intStartMonth = 1			' Number for Month that starts the Year (eg 1 for Jan - Calendar Year)
							' (6 for June and Fiscal Year - Will not categorize files that are newer than 
							' June 2008 if 6 is in intMonth and 2008 is in lngMaxYear
' *******************************************
' *******************************************
							
' Instantiate and Set other Variables							
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strMainDir)
 
' Loop through all subfolders in Main Directory
For Each objSubfolder in objFolder.SubFolders
	' Check each File in this subFolder and see if we need to Move it
	Call CheckandMoveFiles (objSubFolder, objSubFolder)
 
	' Parse Through all SubFolders
	Call ParseSubFolders (objSubFolder, objSubFolder)
Next
 
Set objFSO = nothing
Set objFolder = nothing
Set objFiles = nothing
Set objFile = nothing
Set objSubFolder = nothing
 
msgbox "Done Moving Files"
 
Wscript.quit
 
 
' ----------------------------------------------------------------------------
' Routine to Check each File in Subfolder and move it if it meets the criteria
Sub CheckandMoveFiles (CurrentFolder, MasterFolder)
	Set objFiles = CurrentFolder.Files
 
	' Loop Through all Files in Folder
	For each objFile in objFiles
		' Get Year The File was Last Updated
		intYear = Year(objFile.DateLastModified)
		' Get Month the File was last updated
		intMonth = Month(objFile.DateLastModified)
		
		' See if Fiscal Year, If so add 1 to year
		If (intMonth >= intStartMonth) and (intStartMonth <> 1) Then intYear = intYear + 1
		
		' Check If we are to move the file
		If intYear <= intMaxYear then
			' See if Folder already Exists
			If objFSO.FolderExists(MasterFolder.Path & "/" & intYear) = False then
				' Does not exist so create it 
				objFSO.CreateFolder(MasterFolder.Path & "/" & intYear)
			End If
			
			' Find New Path
			strNewPath = MasterFolder.Path & "/" & intYear
			strNewPath = strNewPath & Right(CurrentFolder.Path, Len(CurrentFolder.Path)-Len(MasterFolder.Path))
			
			' See if this new path exists
			If objFSO.FolderExists(strNewPath) = False then
				' Does not exist so create it 
				objFSO.CreateFolder(strNewPath)
			End If
			
			' Move File
			objFSO.MoveFile objFile.Path, strNewPath & "/"
			
		End If
	Next
		
End Sub
 
' ----------------------------------------------------------------------------
' Parse Through the SubFolders
Sub ParseSubFolders(CurrentFolder, ParseMasterFolder)
    
	For Each SubFolder in CurrentFolder.SubFolders
		' Check if this is an already set year folder.  If so skip it and all subfolders
		If Not(IsNumeric(SubFolder.Name) and (Len(SubFolder.Name)=4)) Then 
		
			' Check each File in this subFolder and see if we need to Move it
			Call CheckandMoveFiles (SubFolder, ParseMasterFolder)
 
			' Parse Through all SubFolders
			Call ParseSubFolders (SubFolder, ParseMasterFolder)
		End IF
	Next
 
End Sub