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,254 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
 
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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

This script checks a path to see if a folder exists. If the folder does exist you will get output "The folder has previously been created. No action taken" If not it will create the folder. Then adds one user modify permission to the folder. It …
This article will help you understand what HashTables are and how to use them in PowerShell.
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

760 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now