Organize Files VBS

Organize Files by Extension VB Script

I have hundreds of gigs worth of files and difficulty finding anything. Before Windows Vista I found that searching for a file could take a half hour and I realized I needed a better way to get organized. I wrote this quick Vistual Basic Script to help organize my files into subfolders by extension and date modifed.

Download Zip

Below is a screenshot of my folders after my files have been copied to their destination.

How it works:

1) It looks at my source folder

2) Copies the file into a new destination (I didn't do move in case something wen wrong)

3) Places the files into a subfolder by its extension and daet modified (Example - test.doc) would go into a doc_2008 folder.

4) Create a log of each file moved (in case it crashes mid-stream I know the last file moved)

License: Open Source (GNU General Public License)

Code:


Dim varstartpath, vardestination

'IMPORTANT - You need to provide a source and destination path.
varsource = "S:\Users\"
vardestination = "R:\Backup"


OrganizeFiles(varsource)

WScript.Echo "Done!"

'-------function to Find File Extensions------------

Function GetExtension(varfile)

'------Split the file by periods--------------------
arrayperiods = Split(varfile,".")
'------Select the characters after the last period--
varnumperiods = UBound(arrayperiods)
'------Return the value to GetExtension
GetExtension = arrayperiods(varnumperiods)

End Function


'-------Sub Procedure to Create Folders Based on File Extensions and Date------------

Sub CreateFolder(varfile,vardate)

Set objFSO = CreateObject("Scripting.FileSystemObject")

'------Find out file extension-----------------------
varextension = GetExtension(varfile)
'-------------------

'------Create a destination folder based on the extension and the year modified
varfolder = vardestination & "\" & varextension & "_" & year(vardate)
'-------------------

'------If the folder doesn't already exist then create it
If Not objFSO.FolderExists(varfolder) Then Set objFolder = objFSO.CreateFolder(varfolder)
'-------------------

Set objFSO=Nothing

End Sub


'-------Sub Procedure to Copy Files to a Folder------------

Sub CopyToFolder(varpath,varfile,vardate)

varextension = GetExtension(varfile)
varfilesourcepath = varpath
varfiledespath = vardestination & "\" & varextension & "_" & year(vardate) & "\" & varfile

Set objFSO = CreateObject("Scripting.FileSystemObject")


'-----Keep a log of files moved so you know where it crashed------------------

'Create or append a text file

varlog = varpath

Set fso = CreateObject("Scripting.FileSystemObject")
fpath= vardestination & "\FilesMoved.txt"
flg=fso.FileExists(fpath)

If flg Then
Set floc= fso.OpenTextFile(fpath, 8)
floc.WriteLine(varlog)
floc.Close
Else
Set floc = fso.CreateTextFile(fpath,true)
floc.WriteLine(varlog)
floc.Close
End If

Set fso = Nothing

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


'------Check to see if File Exists-------------------
If Not objFSO.FileExists(varfiledespath) Then



objFSO.copyFile varfilesourcepath,varfiledespath

Else

set objFileName = objFSO.GetFile(varfilesourcepath)
varsourcesize = objFileName.Size
varsourcemod = objFileName.DateLastModified
Set objFileName = Nothing

set objFileName = objFSO.GetFile(varfiledespath)
vardestsize = objFileName.Size
vardestmod = objFileName.DateLastModified
Set objFileName = Nothing

'------If the file was last modified at the same time and is the same size----

If (varsourcesize = vardestsize) and (varsourcemod = vardestmod) Then

objFSO.copyFile varfilesourcepath,varfiledespath,true

Else

'------If not true then rename the file-------
varyear = year(varsourcemod)
varsourcemod = FormatDateTime(varsourcemod,2)
varsourcemod = Replace(varsourcemod, "/", "_")
arrayperiods = Split(varfile,".")
varitemname = arrayperiods(0)


varfiledespath = vardestination & "\" & varextension & "_" & varyear & "\" & varitemname & "_" & varsourcesize & "_" & varsourcemod & "." & varextension

objFSO.CopyFile varfilesourcepath,varfiledespath,true

End If

End if


Set objFSO=Nothing

End Sub


'-------Sub Procedure to run through the files--------------------

Sub OrganizeFiles(path)

dim fs, folder, file, item, url

set fs = CreateObject("Scripting.FileSystemObject")
set folder = fs.GetFolder(path)

'Display the target folder and info.


'Display a list of sub folders.

for each item in folder.SubFolders
OrganizeFiles(item.Path)
next

'Display a list of files.

for each item in folder.Files

CreateFolder item.Name,item.DateLastModified
CopyToFolder item.path,item.Name,item.DateLastModified


next

set fs = Nothing


end sub

'----------