Filter files into silo folders

Option Explicit

Const FOLDER = "c:\Lots of files\"
Const FILES_PER_SILO = 43

Dim strFolderToProcess
Dim objFSO, objFolder, objFile
Dim colFiles
Dim intFiles, intNumberofSilos, intFilesPerSilo, intTotalNoFiles
Dim objWindow

'Initialise
strFolderToProcess = FOLDER
intFilesPerSilo = FILES_PER_SILO


Set objWindow = new ProgressWindow
objWindow.Initialise "Silo Files", 6, 750, 250

'Initialise the file system objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder= objFSO.GetFolder(strFolderToProcess)
Set colFiles = objFolder.Files

objWindow.UpdateRegion 1, "Calculating number of silos to create..."

intTotalNoFiles = colFiles.Count
intNumberofSilos = Ceil(intTotalNoFiles/intFilesPerSilo)

'Create Silo folders
objWindow.UpdateRegion 1, "Creating silos..."
CreateSiloFolders intNumberOfSilos

'Move files into silo folders
objWindow.UpdateRegion 1, "Calculating number of silos to create..."
MoveFilesToSilos intNumberOfSilos

objWindow.UpdateRegion 1, "Processing complete!"
WScript.sleep 2000
objWindow.Destroy

'########
'# SUBS #
'########

Sub CreateSiloFolders(p_intTotalNumberOfSiloFolders)
	Dim intCounter
	Dim strSiloPath

	For intCounter = 0 to (p_intTotalNumberOfSiloFolders - 1)
		strSiloPath = strFolderToProcess & _
			ExpandNumber(intCounter, p_intTotalNumberOfSiloFolders - 1)
		objWindow.UpdateRegion 2, "Creating silos " & strSiloPath
		CreateFolder strSiloPath
	Next
End Sub


Sub MoveFilesToSilos(p_intTotalNumberOfSiloFolders)
	Dim intCounter, intFolder, intFilesProcessed

	intCounter = 1
	intFolder = 0
	intFilesProcessed = 0

	objWindow.UpdateRegion 3, "<b>Total Progress</b>"
	objWindow.UpdateRegion 5, "<b>Folder Progress</b>"

	For each objFile in colFiles
		objWindow.UpdateRegion 2, "Moving " & objFile.Name & " to " & _
			strFolderToProcess & ExpandNumber(intFolder, p_intTotalNumberOfSiloFolders - 1) & _
				"\" & objFile.Name

		objFile.Move(strFolderToProcess & ExpandNumber(intFolder, p_intTotalNumberOfSiloFolders - 1) _
			& "\" & objFile.Name)

		If intCounter < intFilesPerSilo then
			intCounter = intCounter + 1
		Else
			intFolder = intFolder + 1
			intCounter = 1
		End If

		objWindow.UpdateRegionProgress 4, (intFilesProcessed/intTotalNoFiles)*100, 65
		objWindow.UpdateRegionProgress 6, (intCounter/FILES_PER_SILO)*100, 30

		intFilesProcessed = intFilesProcessed + 1
	Next

	objWindow.UpdateRegion 3, "<b>TRANSFER COMPLETE!</b>"
	objWindow.ClearRegion 4
	objWindow.ClearRegion 5
	objWindow.ClearRegion 6
End Sub


'#########
'# FUNCS #
'#########

Function ExpandNumber(p_strNum, p_strBase)
	ExpandNumber = p_strNum
	While len(ExpandNumber)<len(p_strBase)
		ExpandNumber = "0" & ExpandNumber
	Wend
End Function


Function CreateFolder(p_strFolderPath)
	If objFSO.FolderExists(p_strFolderPath) Then
		CreateFolder = false
	Else
	   	Set objFolder = objFSO.CreateFolder(p_strFolderPath)
		CreateFolder = true
	End If
End Function


Function Ceil(p_Number)
	Ceil = 0 - INT( 0 - p_Number)
End Function



'################
'#### CLASSES ###
'################
'Create an instance of this class to create a progress window based on an HTML page
'displayed in an Internet Explorer window.
Class ProgressWindow

	'Progress Window Properties
	Dim intWidth
	Dim intHeight
	Dim intRegions
	Dim strTitle
	Dim objProgress

	'Create the progress window
	'The first parameter is the title of the progress window.
	'The second parameter is the number of regions on the page you wish to 
	'	be able to update independently.
	'The third parameter is the width of the window in pixels.
	'The fourth parameter is the height of the window in pixels.
	Sub Initialise(p_strTitle, p_intRegions, p_intWidth, p_intHeight)
		'Set class properties
		strTitle = p_strTitle
		intRegions = p_intRegions
		intWidth = p_intWidth
		intHeight = p_intHeight

		'Create the progress window
		CreateMSIEWindow objProgress
	End Sub

	'Display the basic window
	Sub CreateMSIEWindow(p_objMSIE)
		Dim strHTML
		Dim intCounter

		strHTML = ""
		For intCounter = 1 to intRegions
			strHTML = strHTML & _
				"<div id='REGION" & intCounter & "' align='left'></div>"
	 	Next
		strHTML = "<body>" & strHTML & "</body>"

		Set p_objMSIE = CreateObject("InternetExplorer.Application")
		With p_objMSIE
			.Navigate2 "about:blank"
			Do While .readyState <> 4
				Wscript.sleep 10
			Loop
			.Document.Title = strTitle
			.Document.Body.InnerHTML = strHTML
			.Document.Body.Scroll = "no"
			.Toolbar = False
			.StatusBar = False
			.Resizable = False
			.Width = intWidth
			.Height = intHeight
			.Left = 0
			.Top = 0
			.Visible = True
		End With
	End Sub

	'This should be called to close the window
	Sub Destroy()
		objProgress.Quit
	End Sub

	'This method can be used to update the content of a specified region
	Sub UpdateRegion(p_intRegion, p_strContent)
		objProgress.Document.All("REGION" & Cstr(p_IntRegion)).innerHTML = p_strContent
	End Sub

	'This method clears a specified region.
	Sub ClearRegion(p_intRegion)
		UpdateRegion p_intRegion, ""
	End Sub

	'This method clears all of the regions at once.
	Sub ClearAllRegions()
		Dim intRegion

		For intRegion = 1 to intRegions
			UpdateRegion intRegion, ""
		Next
	End Sub

	'Set a progress bar as a region...
	'The first parameter is which region.
	'The second parameter is the percentage completion of the bar.
	'The third parameter is the number of characters that make up the bar.
	Sub UpdateRegionProgress(p_intRegion, p_intPrecentageProgress, p_intCharacterRange)
		'These constants are used to create the progress bar
		Const SOLID_BLOCK_CHARACTER = "&#x2588;"
		Const EMPTY_BLOCK_CHARACTER = "&#x2588;"
		Const SOLID_BLOCK_COLOUR = "#ffcc33;"
		Const EMPTY_BLOCK_COLOUR = "#666666;"

		Dim intSolidBlocks, intEmptyBlocks, intCounter
		Dim strProgress

		'Calculate how many blocks we need to create
		intSolidBlocks = round(p_intPrecentageProgress / 100 * p_intCharacterRange)
		intEmptyBlocks = p_intCharacterRange - intSolidBlocks

		'Build the progress so far blocks
		strProgress = "<span style='color: " & SOLID_BLOCK_COLOUR & "'>"
		intCounter = 0
		While intCounter < intSolidBlocks
			strProgress = strProgress & SOLID_BLOCK_CHARACTER
			intCounter = intCounter + 1
		Wend

		'Build the progress to be met blocks
		strProgress = strProgress & "</span><span style='color: " & _
			EMPTY_BLOCK_COLOUR & "'>"
		intCounter = 0
		While intCounter < intEmptyBlocks
			strProgress = strProgress & EMPTY_BLOCK_CHARACTER
			intCounter = intCounter + 1
		Wend
		strProgress = strProgress & "</span>"

		'Set the specified region to be the blocks
		UpdateRegion p_intRegion, strProgress
	End Sub

End Class