IDEA: Moving selected files to date based folders

[kartal]

It would be neat to have an explorer right click funtion that can move files in a folder to date based(monthly, yearly or user defined intervals) folders. So you select the files run the app, select the interval, the software checks modified or creation dates of files, creates date absed folders and move files in proper folders.

[Armando]

I'm curious : there are probably many uses for such a utility, but why will you (personally) want to move files to date "based" (identified?) folders? For archiving purpose I guess?

[kartal]

Yes archiving mainly. Sometimes I endup with many files within one folder. Best way would be cataloging based on dates I assume.

[Armando]

I see. Yes, this is how I do it too -- but for backup or archiving on external media only. Otherwise I don't bother. A good  naming scheme and desktop search software are my friends as far as my internal hard drive is concerned. 

[SirSmiley]

Here's an extension that Lifehacker covered recently
http://lifehacker.co...ls-right+click-tools

Haven't tested this myself...yet.

I may already have a standard vbs drop script that you could put in the sendto folder.

Is the directory structure something like this:
Year|Month|Day
Eg. 2008|04|10

[kartal]

I installed it and it does not do anything under xp, and it looks like it does not work on selected files


edit: It did not like non standard installation location. Installing under program files worked.

Sir Smiley, I use Day_Month_Year generally. Althou Year_Month_Day would be more applicable to directories I guess

[Armando]

Year_Month_Day seems like the way to go for any classification, whether folders or files. Stuff get all mixed up otherwise -- years don't repeat, but days and month do, so it makes more sense. 

[kartal]

I normally use light year but human years is fine in this case too

[SirSmiley]

Next you'll want star date!

Are you meaning moving into just one folder or a directory tree?

[SirSmiley]

Here's a simple vbscript file with no recursion.

[Select]

'*********************************************************
' Sorter.vbs
'
' 3:30 PM 11/04/2008
'
' A. Timperley aka SirSmiley
'
' Purpose:
' Sort Files Into Date Specific Folders. Creates folders if none exist.
' Non-Recursive. Eg. Doesn't do subfolders
' Inputs:
' Dropped Folders
' Returns:
' Msgbox notification on completion
'*********************************************************
'Year|Month|Day
Dim objArgs : Set objArgs = WScript.Arguments
Dim arrDropFldrs()
Dim arrDropFiles()

Dim blnRecurse : blnRecurse=False

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
' Set the path to your target folder here
Dim objTargetFldr : objTargetFldr = "C:\Programming\Sandbox\x"
' Special character
' Use double quotes with no space if you wish to have a straight date
Dim sSC : sSC = "."
' Configure Sorting Method
' 1 = Date Created | 2 = Date Last Accessed | 3 = Date Last Modified
Dim iSortDate : iSortDate = 3

'Splits dropped folders into an array
' You can drop multiple folders this way
For I = 0 to objArgs.Count - 1
If I <0 Then
WScript.Quit
  Else
' Build Array from Dropped Items
ReDim Preserve arrDropFldrs(I)
arrDropFldrs(I)=objArgs(I)
  End If
  Call FilesToFolder
Next

' Checks to see if Target Date Folder Exists
' Creates one if none exists
Function DateFolder(strDate)
' Format Date
strSortDate = DatePart("yyyy",strDate)&sSC
If DatePart("m",strDate) < 10 Then
strSortDate = strSortDate & "0"
End If
strSortDate = strSortDate & DatePart("m",strDate)&sSC
If DatePart("d",strDate) < 10 Then
strSortDate = strSortDate & "0"
End If
strSortDate = strSortDate & DatePart("d",strDate)
strTargetFldr = objTargetFldr&"\"&strSortDate
If objFSO.FolderExists(strTargetFldr) Then
DateFolder=strTargetFldr&"\"
Else'If objFSO.FolderExists(strTargetFldr)=False Then
objFSO.CreateFolder(strTargetFldr)
DateFolder=strTargetFldr&"\"
End IF
End Function

' Creates File Collection from Folders in Array. Sorts Accordingly
Sub FilesToFolder
For i=0 To UBound(arrDropFldrs)
strFolder=arrDropFldrs(i)
' Get Folder
Set objFolder = objFSO.GetFolder(strFolder)
' Get's File Collection
Set objFileCol=objFolder.Files
For Each File In objFileCol
If iSortDate = 1 Then
strTargetFldr = DateFolder(File.DateCreated)
objFSO.MoveFile File,strTargetFldr
ElseIf iSortDate = 2 Then
strTargetFldr= DateFolder(File.DateLastAccessed)
objFSO.MoveFile File,strTargetFldr
ElseIf iSortDate = 3 Then
strTargetFldr= DateFolder(File.DateLastModified)
objFSO.MoveFile File,strTargetFldr
End If
Next
Next
msgbox "Complete"
End Sub

[kartal]

Thanks SirSmiley, but how do you use it?

[SirSmiley]

I can add in some basic input boxes if you want or you can do it this way:

Edit it with Metapad or Notepad++ (or MS Notepad if you must .
Paste and save as a vbscript file. The parts you need to change are:

• objTargetFldr="Path you want to create the date folders in"
• Sorting Method- Set for Date Last Modified by default see the comment for changes
• Change sSC = "." to what ever character you want to divide the date by or "" for no character
• Rearrange the If Statements in the DateFolder Function to change how you want to display the folders

Then move the edited file to your SendTo Folder. When you right click on a folder(s) and select the file it will move the folders. You can also drag and drop the folders you want to sort directly on to the script



objTargetFolder="Path to folder

[kartal]

SirSMiley, I was hoping that I would not need to define a target folder. Because generally speaking if I select some files and drop them into dated folders, probably I would want new date folders to be in the current folder. Moving them to somewhere else afterwards is easier job because.


I will try this method now thou.

[SirSmiley]

Ooo! That's actually fairly easy compared to what I've been working on.

Delete or comment out everything after declaring the Target folder variable:

[Select]

Dim objTargetFldr ': objTargetFldr = "C:\Programming\Sandbox\x"

In the FilesToFolder Sub Add One Line:

[Select]

' Find the line below
Set objFolder = objFSO.GetFolder(strFolder)
' Add the next line right after it
objTargetFldr = objFolder

[kartal]

Works!! Thanks

It would be great if it works on selected files as well. A the moment it works only on selected folders

[kartal]

also would it be possible to have it only with year and month? We can then add it as seperate script to send to

[SirSmiley]

When you say sort files do you mean together with the folders as in you drop/send 5 folders and 20 files?
Also are the files all going to be from one folder? If that's the case then it's pretty simple but, if it's files for many folders through Explorer Search then it would slow down the script quite a bit since you'd have to get the parent folder for each file then create the sub folders.

To change the format to year and month do the following in the date folder function:

[Select]

' Comment or delete the special character function at the end of the next line
strSortDate = strSortDate & DatePart("m",strDate)'&sSC
' Comment out or delete the next if statement and string
' If DatePart("d",strDate) < 10 Then
' strSortDate = strSortDate & "0"
' End If
' strSortDate = strSortDate & DatePart("d",strDate)

[kartal]

all selections would be in same folder

[SirSmiley]

Here you go. You'll have to modify the date function still.

[Select]

'*********************************************************
' Sorter.vbs
'
' 3:30 PM 11/04/2008
'
' A. Timperley aka SirSmiley
'
' Purpose:
' Sort Files Into Date Specific Folders. Creates folders if none exist.
' Non-Recursive. Eg. Doesn't do subfolders
' Inputs:
' Dropped Folders
' Returns:
' Msgbox notification on completion
'*********************************************************

Dim objArgs : Set objArgs = WScript.Arguments
' Declore array's
Dim arrDropItems() ' all dropped items

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
' Set the path to your target folder here
Dim objTargetFldr ': objTargetFldr = "C:\Programming\Sandbox\x"
' Special character
' Use double quotes with no space if you wish to have a straight date
Dim sSC : sSC = "."
' Configure Sorting Method
' 1 = Date Created | 2 = Date Last Accessed | 3 = Date Last Modified
Dim iSortDate : iSortDate = 3

'Splits dropped folders into an array
' You can drop multiple folders this way
For I = 0 to objArgs.Count - 1
If I <0 Then
WScript.Quit
  Else
' Build Array from Dropped Items
ReDim Preserve arrDropItems(I)
arrDropItems(I)=objArgs(I)
  End If 
Next

Call ArraySort
' Sort Array
Function ArraySort
For i=0 To UBound(arrDropItems)
' Determines if dropped item is a folder or file
  If objFSO.FolderExists(objArgs(i)) Then
Call SortFolders(objArgs(I))
ElseIf objFSO.FileExists(objArgs(i)) Then
Call SortFiles(objArgs(I))
End If 
Next
End Function
' Checks to see if Target Date Folder Exists
' Creates one if none exists
Function DateFolder(strDate)
' Format Date
strSortDate = DatePart("yyyy",strDate)&sSC
If DatePart("m",strDate) < 10 Then
strSortDate = strSortDate & "0"
End If
strSortDate = strSortDate & DatePart("m",strDate)&sSC
If DatePart("d",strDate) < 10 Then
strSortDate = strSortDate & "0"
End If
strSortDate = strSortDate & DatePart("d",strDate)
strTargetFldr = objTargetFldr&"\"&strSortDate
If objFSO.FolderExists(strTargetFldr) Then
DateFolder=strTargetFldr&"\"
Else'If objFSO.FolderExists(strTargetFldr)=False Then
objFSO.CreateFolder(strTargetFldr)
DateFolder=strTargetFldr&"\"
End IF
End Function

' Creates File Collection from Folders in Array. Sorts Accordingly
Sub SortFolders(strFolder)
Set objFolder = objFSO.GetFolder(strFolder)
objTargetFldr = objFolder'
' Get's File Collection
Set objFileCol=objFolder.Files
For Each File In objFileCol
If iSortDate = 1 Then
strTargetFldr = DateFolder(File.DateCreated)
objFSO.MoveFile File,strTargetFldr
ElseIf iSortDate = 2 Then
strTargetFldr= DateFolder(File.DateLastAccessed)
objFSO.MoveFile File,strTargetFldr
ElseIf iSortDate = 3 Then
strTargetFldr= DateFolder(File.DateLastModified)
objFSO.MoveFile File,strTargetFldr
End If
Next
msgbox "Folder Contents Sorting Complete"
End Sub

' Sort's Files to Date Formated Folders
Sub SortFiles(strFile)
Set strFile=objFSO.GetFile(strFile)
strFolder=objFSO.GetParentFolderName(strFile)
strFolder=objFSO.GetAbsolutePathName(strFolder)
Set objFolder = objFSO.GetFolder(strFolder)
objTargetFldr = objFolder
If iSortDate = 1 Then
strTargetFldr = DateFolder(strFile.DateCreated)
objFSO.MoveFile strFile,strTargetFldr
ElseIf iSortDate = 2 Then
strTargetFldr= DateFolder(strFile.DateLastAccessed)
objFSO.MoveFile strFile,strTargetFldr
ElseIf iSortDate = 3 Then
strTargetFldr= DateFolder(strFile.DateLastModified)
objFSO.MoveFile strFile,strTargetFldr
End If
msgbox "Files Sorting Complete"
End Sub

[SirSmiley]

One thing to remember is there are limits to how many files that can be passed using WScript Arguments.
I think it's 25?

Then if you've got hundreds of files you want to select and run this script on, I think there may be other issues.

[kartal]

Thanks!

Here is the issue with selected files, it brings up a confirmation pop up dialog for every file. But it works.

[SirSmiley]

Simple Solution. Comment out the msgbox

[kartal]

Thanks!! I will try now