Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

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

Posted on 2009-04-04
31
1,260 Views
Last Modified: 2012-05-06
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

0
Comment
Question by:gamm
  • 21
  • 10
31 Comments
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24069499
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

Open in new window

0
 
LVL 4

Author Comment

by:gamm
ID: 24103730
Thanks, that's looking good.
I did mean vbs, thanks for the correction.

I'm getting an error when I run the script:

C:\Temp\FileByDate.vbs
Line: 73
Char: 5
Error: Path not found
Code: 800A004C
Source: Microsoft VBScript runtime error
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24104093
Sorry.  I see the problem in my logic - forgot to account for folders that have not files to move, but a sub folder does.  Try the code below, changing he needed variables as mentioned above.



' VB Script to Categorize Files by Date
 
' Declare Variables
Dim strMainDir, lngMaxYear, intStartMonth
Dim objFSO, objFolder, objFiles, objFile
Dim objSubfolder, intYear, intMonth, strNewPath
Dim strPath
 
' 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))
			
			' Split it up to make sure all folders exist
			strPath = split(strNewPath, "\")
			strNewPath = strPath(0)
			
			' Loop Through all Folders to make sure they exist
			For i = 1 to uBound(strPath)
				strNewPath = strNewPath & "\" & strPath(i)
				' See if this new path exists
				If objFSO.FolderExists(strNewPath) = False then
					' Does not exist so create it 
					objFSO.CreateFolder(strNewPath)
				End If
			Next
			
			' 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

Open in new window

0
NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

 
LVL 4

Author Comment

by:gamm
ID: 24104825
Thanks.

No error that time, but mixed results, some files were moved exactly as desired :) however there are still quite a number of files left in the original location that are not moved.

I checked the modified dates and they do fall below the intMaxYear date (which I set to intMaxYear = 2006), so they should have been moved into the related folders.

I'll spend some time comparing the original file structure to the restructured one after the script has been run on it.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24106684
gamm,

Can you post the script as you ran it and a listing of a few of the modify dates there not moved?  Also if possible, can you list the path of the files that were not moved?  I will see if I can find the problem.

-Bear
0
 
LVL 4

Author Comment

by:gamm
ID: 24113276
I'll post up a directory listing on a password protected site rather than posting it up on a public site, that way I can remove it after you've downloaded it.

If so I'll post up a before and after list.
I'm back in the office on Tuesday, will post it then.
0
 
LVL 4

Author Comment

by:gamm
ID: 24133756
Ok, I'm going to run it again now & I'll post up the results shortly.
0
 
LVL 4

Author Comment

by:gamm
ID: 24133908
You can access the files here:
http://drop.io/jiv72ch
Password is your Experts-Exchange username
0
 
LVL 4

Author Comment

by:gamm
ID: 24134299
Please let me know when you have downloaded them so that I can remove them from the web page.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24134408
I have the files.  Can you also post the script that you ran so I can see variable settings.  I will not have time to look at this tonight.  I will try to look tomorrow.

-Bear.
0
 
LVL 4

Author Comment

by:gamm
ID: 24134456
I only changed the variables in the last script you posted, the variables I used are below:
0
 
LVL 4

Author Comment

by:gamm
ID: 24134460

strMainDir = "C:\Temp\Clients"
intMaxYear = 2006
intStartMonth = 1

Open in new window

0
 
LVL 4

Author Comment

by:gamm
ID: 24134494
btw, for a vague bit of anonimity for our clients I ran a replace so that a,i,o,u were all replaced with e, except for the words:
"Client"
"2006 and before"
".doc"

I ran it on both before and after results so shouldn't make any difference.

If after looking at the results you think that doing this may have hindered you analysis let me know & I will sort something out.

Thanks for all your help so far.
0
 
LVL 4

Author Comment

by:gamm
ID: 24143570
I should also mention, so that it's easier for you when looking through the lists, that under each client's original folder is a folder called "2006 and before" this is primarily where the 2006 & earlier files are located that should be moved and where, if any, are remaining. We started filing by year from 2007, though there may be a few files that weren't filed correctly but I can deal with those separately.

I've had a look through a bunch of them and I can confirm that they are various years, all at or below 2006. The earliest I saw in the brief look I had was about 1998.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24143776
Gamm,

Found the problem.  I had some logic in my code to keep it from moving a file it already moved by checking if the name of the folder was a year.  Unfortunately you have some folders that fit that criteria.  I have changed my logic to check this in a different way that should work.  Give the below code a try and let me know.

-Bear

' VB Script to Categorize Files by Date
 
' Declare Variables
Dim strMainDir, lngMaxYear, intStartMonth
Dim objFSO, objFolder, objFiles, objFile
Dim objSubfolder, intYear, intMonth, strNewPath
Dim strPath
 
' Set Variables that drive behavior
strMainDir = "C:\Temp\Clients"	' Main Directory to be categorized
intMaxYear = 2006			' 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))
			
			' Split it up to make sure all folders exist
			strPath = split(strNewPath, "\")
			strNewPath = strPath(0)
			
			' Loop Through all Folders to make sure they exist
			For i = 1 to uBound(strPath)
				strNewPath = strNewPath & "\" & strPath(i)
				' See if this new path exists
				If objFSO.FolderExists(strNewPath) = False then
					' Does not exist so create it 
					objFSO.CreateFolder(strNewPath)
				End If
			Next
 
			' Check if the parent path includes the target path
			If instr(objFile.parentfolder, MasterFolder.Path & "\" & intYear) = 0 Then
				' The File is not in the proper folder, move it there
				objFSO.MoveFile objFile.Path, strNewPath & "\"
			End If
			
		End If
	Next
		
End Sub
 
' ----------------------------------------------------------------------------
' Parse Through the SubFolders
Sub ParseSubFolders(CurrentFolder, ParseMasterFolder)
    
	For Each SubFolder in CurrentFolder.SubFolders
		' 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)
	Next
 
End Sub

Open in new window

0
 
LVL 4

Author Comment

by:gamm
ID: 24143819
I also tried changing
intStartMonth = 7 (for financial year 1 July - 30 June)
The same issue resulted.

I've changed it back to
intStartMonth = 1
0
 
LVL 4

Author Comment

by:gamm
ID: 24143821
Sorry, posted that last comment before refreshing the page so didn't see your last comment.. I will try the new script now..
0
 
LVL 4

Author Comment

by:gamm
ID: 24143855
Still same issue. Actually, some files that were previously moved correctly are now not moving. I'll post up the before and after results in a moment.

Hmm, I wonder if it is because the folder that we are primarily moving files out of starts with '2006'? "2006 and before".
0
 
LVL 4

Author Comment

by:gamm
ID: 24143902
I've posted the files up. Please let me know when you've downloaded them so I can remove them - thanks.

I've used a smaller file base to start with to make it a bit easier & quicker, I can use more files later.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24144102
I have the files.  The only thing I can come up with right now is that the modify date on some of those files is more recent.  I have adjusted the script to create a log so I can see what it is doing.  It will create a file called vbscriptlog.txt and place it in the main directory (strMainDir).  If you could post that file for me, it would help out.  It does store file paths and names.  It is a tab delimited file, so if you want to adjust some names you can open in Excel or Calc and adjust values in columns 1 & 7 or A and G in the spreadsheet.  

' VB Script to Categorize Files by Date
 
' Declare Variables
Dim strMainDir, lngMaxYear, intStartMonth
Dim objFSO, objFolder, objFiles, objFile
Dim objSubfolder, intYear, intMonth, strNewPath
Dim strPath
Dim strMsg
 
' Set Variables that drive behavior
strMainDir = "C:\Temp\Clients"	' Main Directory to be categorized
intMaxYear = 2006			' 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)
If objFSO.FileExists(strMainDir & "\vbscriptlog.txt") Then
	Set oText = objFSO.OpenTextFile (strMainDir & "\vbscriptlog.txt", 8)
Else
	Set oText = objFSO.CreateTextFile(strMainDir & "\vbscriptlog.txt")
End If
 
' 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
		
		strMsg = objFile.Path & vbtab & objFile.DateLastModified & vbtab & intYear & vbTab & intMaxYear & vbtab
		strMsg = strMsg & intMonth & vbtab & intStartMonth & vbTab & MasterFolder.Path & "\" & intYear & vbTab
		
		' Check If we are to move the file
		If intYear <= intMaxYear then
			strMsg = strMsg & "Passed Year Check"
			' 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))
			
			' Split it up to make sure all folders exist
			strPath = split(strNewPath, "\")
			strNewPath = strPath(0)
			
			' Loop Through all Folders to make sure they exist
			For i = 1 to uBound(strPath)
				strNewPath = strNewPath & "\" & strPath(i)
				' See if this new path exists
				If objFSO.FolderExists(strNewPath) = False then
					' Does not exist so create it 
					objFSO.CreateFolder(strNewPath)
				End If
			Next
 
			' Check if the parent path includes the target path
			If instr(objFile.parentfolder, MasterFolder.Path & "\" & intYear) = 0 Then
				strMsg = strMsg & vbtab & "File Moved"
				' The File is not in the proper folder, move it there
				objFSO.MoveFile objFile.Path, strNewPath & "\"
			End If
			
		End If
		oText.Writeline strMsg
	Next
		
End Sub
 
' ----------------------------------------------------------------------------
' Parse Through the SubFolders
Sub ParseSubFolders(CurrentFolder, ParseMasterFolder)
    
	For Each SubFolder in CurrentFolder.SubFolders
		' 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)
	Next
 
End Sub

Open in new window

0
 
LVL 4

Author Comment

by:gamm
ID: 24144142
Ok, I've posted it up.
I've also posted the after directory structure.
0
 
LVL 4

Author Comment

by:gamm
ID: 24144178
I've left the details in the files unchanged this time rather than changing the names of the files, for simplicity.
0
 
LVL 4

Author Comment

by:gamm
ID: 24144226
I've posted a new password text file on the web page, once you've downloaded that & the other 2 files let me kow I will change the password for the web page.
Thanks.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24144240
OK one more try.  I did find one file in the test that was in the 2006 and before folder with a data modified of 2009 (Thumbs.db).  The rest should have moved and I think this code might do it.  Give it a shot and let me know.  (I took at the logging for now).



' VB Script to Categorize Files by Date
 
' Declare Variables
Dim strMainDir, lngMaxYear, intStartMonth
Dim objFSO, objFolder, objFiles, objFile
Dim objSubfolder, intYear, intMonth, strNewPath
Dim strPath
Dim strMsg
 
' Set Variables that drive behavior
strMainDir = "C:\Temp\Clients"	' Main Directory to be categorized
intMaxYear = 2006			' 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))
			
			' Split it up to make sure all folders exist
			strPath = split(strNewPath, "\")
			strNewPath = strPath(0)
			
			' Loop Through all Folders to make sure they exist
			For i = 1 to uBound(strPath)
				strNewPath = strNewPath & "\" & strPath(i)
				' See if this new path exists
				If objFSO.FolderExists(strNewPath) = False then
					' Does not exist so create it 
					objFSO.CreateFolder(strNewPath)
				End If
			Next
		
			' Check if the parent path includes the target path
			If instr(objFile.parentfolder, MasterFolder.Path & "\" & intYear) = 0 Then
				' The File is not in the proper folder, move it there
				objFSO.MoveFile objFile.Path, strNewPath & "\"
			End If
			
		End If
	Next
		
End Sub
 
' ----------------------------------------------------------------------------
' Parse Through the SubFolders
Sub ParseSubFolders(CurrentFolder, ParseMasterFolder)
    
	For Each SubFolder in CurrentFolder.SubFolders
		' 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)
	Next
 
End Sub

Open in new window

0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24144244
Just grabbed the new password file.
0
 
LVL 4

Author Comment

by:gamm
ID: 24144333
I've posted up the results - "after5.txt".
Client 5 seems to work fine, Client 3 and Client 6 are partially moved again.
0
 
LVL 20

Accepted Solution

by:
ltlbearand3 earned 500 total points
ID: 24144336
Oops posted the old code.  Here is the new code.

' VB Script to Categorize Files by Date
 
' Declare Variables
Dim strMainDir, lngMaxYear, intStartMonth
Dim objFSO, objFolder, objFiles, objFile
Dim objSubfolder, intYear, intMonth, strNewPath
Dim strPath
Dim strMsg
 
' Set Variables that drive behavior
strMainDir = "C:\Temp\Clients"	' Main Directory to be categorized
intMaxYear = 2006			' 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))
			
			' Split it up to make sure all folders exist
			strPath = split(strNewPath, "\")
			strNewPath = strPath(0)
			
			' Loop Through all Folders to make sure they exist
			For i = 1 to uBound(strPath)
				strNewPath = strNewPath & "\" & strPath(i)
				' See if this new path exists
				If objFSO.FolderExists(strNewPath) = False then
					' Does not exist so create it 
					objFSO.CreateFolder(strNewPath)
				End If
			Next
		
			' Check if the parent path includes the target path
			If instr(objFile.parentfolder & "\", MasterFolder.Path & "\" & intYear & "\") = 0 Then
				' The File is not in the proper folder, move it there
				objFSO.MoveFile objFile.Path, strNewPath & "\"
			End If
			
		End If
	Next
		
End Sub
 
' ----------------------------------------------------------------------------
' Parse Through the SubFolders
Sub ParseSubFolders(CurrentFolder, ParseMasterFolder)
    
	For Each SubFolder in CurrentFolder.SubFolders
		' 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)
	Next
 
End Sub

Open in new window

0
 
LVL 4

Author Comment

by:gamm
ID: 24144472
That's looking good, I'll try it on a larger file base & check how it goes.
0
 
LVL 4

Author Comment

by:gamm
ID: 24154090
Looks like it's working perfectly :)
Thank you very much.
0
 
LVL 4

Author Closing Comment

by:gamm
ID: 31566530
Thank you very much for your excellent support.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24154143
Your welcome.  Glad to hear we finally got it.
0

Featured Post

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this previous article (https://oddytee.wordpress.com/2016/05/05/provision-new-office-365-user-and-mailbox-from-exchange-hybrid-via-powershell/), we made basic license assignments to users in O365. When I say basic, the method is the simplest way …
A brief introduction to what I consider to be the best editor for PowerShell.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question