'Using VBScript To Automate eBay Turbo Listing HTML Page Editing
'Copyright 2007 Doug Vanderweide, dba Rescue-ME
'http://www.dougv.com

'Distributed under the Creative Commons Attribution / Share-Alike License
'http://creativecommons.org/licenses/by-sa/3.0/

'Any distribution or derivative work based on this script must include the
'original source code from this work, and must retain this copyright
'notice block intact.

'*********************************************************************
'INSTALLATION
'
'To install, save this script with the .vbs extension to your computer
'
'Then change the values below to meet your settings
'*********************************************************************

Dim folderToSort 'raw camera images folder
folderToSort = "C:\\TEST\ToSort\"			
Dim folderSorted 'where sorted images folders go
folderSorted = "C:\\TEST\Sorted\"			
Dim folderBaseName 'base names for sorted folder groups
folderBaseName = "000000"				    
Dim strHTMLExtension 'file extension for HTML files
strHTMLExtension = ".html"				    
Dim intImagesPerFolder 'number of images for each sorted subfolder, cannot be 0
intImagesPerFolder = 5				        
Dim strHTMLTemplate 'the HTML template file
strHTMLTemplate = "C:\\TEST\template.html"	
Dim strReplace 'string to replace with folder name in HTML files
strReplace = "{REPLACE}"

'*****************************
'DON'T CHANGE BELOW THIS LINE!
'*****************************

Dim I, X, Z 'generic looping variables
I = 0   					                        
X = 0                                               
Dim objFSO, objFolder, objFile 'declare FSO variable names
Dim intFolderBaseNameLength 'length of folder base name
intFolderBaseNameLength = Len(folderBaseName)	    
Dim strTemp 'generic temp variable
strTemp = ""                                        

'open folder
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(folderToSort)

'create array of file names & populate it
Dim arrFiles()
For Each objFile In objFolder.Files
    If InStr(LCase(objFile.Name), ".jpg") > 0 Then
        ReDim Preserve arrFiles(X)
	    arrFiles(X) = objFile.Name
	    X = X + 1
	End If
Next

'bubble sort the array
For I = UBound(arrFiles) - 1 To 0 Step -1
    For Z = 0 to I
        If arrFiles(Z) > arrFiles(Z + 1) Then
            strTemp = arrFiles(Z + 1)
            arrFiles(Z + 1) = arrFiles(Z)
            arrFiles(Z) = strTemp
        End If
    Next
Next 

'remove folder object
Set objFolder = Nothing
Set objFSO = Nothing

'get count of total subfolders to create
Dim intTmp 
intTmp = X / intImagesPerFolder
intTotalFolders = CInt(intTmp)

'may need to add one folder due to limitations of CInt rounding
If (intImagesPerFolder * intTotalFolders) < X Then
	intTotalFolders = intTotalFolders + 1
End If

'get integer for first folder name
Dim intFirstFolder 
intFirstFolder = GetHighestSortedSubfolderName(folderSorted)
intFirstFolder = CInt(intFirstFolder)
intFirstFolder = intFirstFolder + 1

'create subfolders
I = CreateSubFolders(folderSorted, folderBaseName, intFirstFolder, intTotalFolders, intFolderBaseNameLength)

'Move images to new subfolders
Dim intCurrentFolder 
intCurrentFolder = intFirstFolder - 1
Dim strCurrentFolder

Set objFSO = CreateObject("Scripting.FileSystemObject")

For I = 0 to UBound(arrFiles)
	'change subdirectory every however many files per subdirectory
	If I Mod (intFolderBaseNameLength - 1) = 0 Then
		intCurrentFolder = intCurrentFolder + 1
		strCurrentFolder = folderSorted & Right(CStr(folderBaseName) & CStr(intCurrentFolder), intFolderBaseNameLength) & "\"
	End If

	'move files
	strTemp = folderToSort & arrFiles(I)
	Set objFile = objFSO.GetFile(strTemp)
	strTemp = strCurrentFolder & arrFiles(I)
	objFile.Move(strTemp)
Next

'clean up FSO object
Set objFSO = Nothing

'Rename all files in subfolders
I = RenameFilesInSubfolders(folderSorted)

'create html files
I = MakeHTMLFiles(strHTMLTemplate, folderSorted, strHTMLExtension, intFirstFolder, strReplace)

MsgBox("Job Complete")

'*******************************
'END OF LOGIC
'*******************************

'*******************************
'Functions and Subroutines
'*******************************

Function GetHighestSortedSubfolderName(folderSorted)
	'Returns highest ID of subfolder name
	'Assumes sorted folders remain in folderSorted
	Dim objFSO, objRoot, objFolder

	'Declare output variable
	Dim strFolder 
	strFolder = ""

	'Open parent folder
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objRoot = objFSO.GetFolder(folderSorted)
	
	For Each objFolder in objRoot.SubFolders
		If objFolder.Name > strFolder Then
			strFolder = objFolder.Name
		End If
	Next

	'clean up objects
	Set objFolders = Nothing
	Set objFSO = Nothing

	'return output
	GetHighestSortedSubfolderName = strFolder
End Function

Function CreateSubFolders(folderSorted, strFolderBaseName, intFirstFolder, intTotalFolders, intFolderBaseNameLength)
	'Creates the subfolders
	Dim I 
	I = intFirstFolder
	Dim X 
	X = I + intTotalFolders
	Dim strFolderName
	strFolderName = ""
	
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	
	Do While I < X
		strFolderName = CStr(strFolderBaseName) 
		strFolderName = strFolderName & CStr(I)
		strFolderName = Right(strFolderName, intFolderBaseNameLength)
		objFSO.CreateFolder(folderSorted & strFolderName)
		I = I + 1
	Loop

	'Clean up objects
	Set objFSO = Nothing
	CreateSubFolders = True
End Function

Function RenameFilesInSubfolders(folderSorted)
	'Renames files
	'Assumes all files are JPGs
	'outputs lower-case .jpg extension to all files in each subfolder
	Dim I, objFSO, objRoot, objFolder, objFile

	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objRoot = objFSO.GetFolder(folderSorted)
	
	For Each objFolder in objRoot.SubFolders
		I = 1
		For Each objFile In objFolder.Files
		    If InStr(LCase(objFile.Name), ".jpg") > 0 Then
			    objFile.Name = CStr(I) & ".jpg"
			    I = I + 1
			End If
		Next
	Next
	
	Set objRoot = Nothing
	Set objFSOs = Nothing
	RenameFilesInSubfolders = True
End Function

Function MakeHTMLFiles(strHTMLTemplate, folderSorted, strHTMLExtension, intFirstFolder, strReplace)
	Dim objFSO, objRoot, objFolder, objFile, strFileName, strTemp, strOut, objOut

	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objRoot = objFSO.GetFolder(folderSorted)
	Set objFile = objFSO.OpenTextFile(strHTMLTemplate, 1)

	strTemp  = objFile.ReadAll

	For Each objFolder In objRoot.SubFolders
	    If CInt(objFolder.Name) >= intFirstFolder Then
		    strFileName = objFolder.Name & strHTMLExtension
		    strOut = Replace(strTemp, strReplace, objFolder.Name)
		    Set objOut = objFSO.CreateTextFile(folderSorted & strFileName, True)
		    objOut.Write(strOut)
		    objOut.Close
		    Set objOut = Nothing
		End If
	Next

	Set objFile = Nothing
	Set objRoot = Nothing
	Set objFSO = Nothing
	MakeHTMLFiles = True
End Function