'Renames a file to start with a number. Automatically increments the number
'based on the highest existing number in the directory. Won't rename a file 
'if it already starts with a number which matches the target pattern.
'Although you can drop a single file on this script, the most common use
'is to renumber all files in a folder. While you CAN'T drop a folder on the 
'script, running the script without arguments will toggle a right-click 
'option on directories to enable name-sorted numbering of all files 
'(except previously-numbered files) in that directory

Option Explicit
Const NUMBER_STEP = 10 'File numbering will increment by this amount
Const NUMBER_DIGITS = 4 'Numbers will have this many digits (with leading zeros)
Const NUMBER_DELIMITER = "-" 'The character that follows the leading number
Main

Sub Main
Dim oFolder, oFile, fs, lngNumber
	Set fs = CreateObject("Scripting.FileSystemObject")
	If WScript.Arguments.Count = 0 Then ToggleRightClick 
	If Wscript.Arguments.Count <> 1 Then Exit Sub
	If Not fs.FileExists(WScript.Arguments(0)) Then Exit Sub
	Set oFolder = fs.GetFolder(fs.GetParentFolderName(WScript.Arguments(0)))
	Set oFile = fs.GetFile(WScript.Arguments(0))
	'Don't number a file if it's already been numbered!
	If Mid(oFile.Name, NUMBER_DIGITS + 1, 1) = NUMBER_DELIMITER Then
		If IsNumeric(Left(oFile.Name, NUMBER_DIGITS)) Then
			Exit Sub
		End If
	End If
	'Find the highest numbere file in the directory ...
	lngNumber = HighestNumber(oFolder)
	'... and rename our file to start with the next number
	oFile.Name = Right(String(NUMBER_DIGITS, "0") & Cstr(lngNumber + NUMBER_STEP), 4) & NUMBER_DELIMITER & oFile.Name
End Sub

Function HighestNumber(objFolder)
Dim fils, fil, fols, fol, lngNumber, strName
	On Error Resume Next
	'Get each file in turn
	lngNumber = 0
	Set fils = objFolder.Files
	If Err.Number = 0 Then
		For Each fil In fils
			strName = fil.Name
			If Len(strName) > NUMBER_DIGITS + 5 Then
				If Mid(strName, NUMBER_DIGITS + 1, 1) = NUMBER_DELIMITER Then
					If IsNumeric(Left(strName, NUMBER_DIGITS)) Then
						If CLng(Left(strName, NUMBER_DIGITS)) > lngNumber Then
							lngNumber = CLng(Left(strName, NUMBER_DIGITS))
						End If
					End If
				End If
			End If
		Next
	End If
	HighestNumber = lngNumber
End Function

Sub Status(strMessage)
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
		Wscript.Echo strMessage
	End If
End Sub

Sub ToggleRightClick()
' Adds or deletes this script as a right-click option for "Directory"
Dim ws, fs, strKey
	Set ws = CreateObject("Wscript.Shell")
	Set fs = CreateObject("Scripting.FileSystemObject")
	
	On Error Resume Next
	
	strKey = "HKEY_CLASSES_ROOT\Directory\shell\" & fs.GetBaseName(WScript.ScriptName) & "\"
	If RightClickEnabled(strKey) Then
		ws.RegDelete strKey & "command\"
		ws.RegDelete strKey
		MsgBox "Right-Click option on folders for this script has been REMOVED",,fs.GetBaseName(WScript.ScriptName)
	Else
		ws.RegWrite strKey & "command\", _
		"cmd.exe /c for /f ""delims="" %%x in ('dir /b /s /on ""%1""') " _
		& "do cscript.exe """ & Wscript.ScriptFullName & """ ""%%x""" _
		, "REG_EXPAND_SZ"
		MsgBox "Right-Click option on folders for this script has been ADDED",,fs.GetBaseName(WScript.ScriptName)
	End If
End Sub

Function RightClickEnabled(strKey)
Dim ws, fs
	Set ws = CreateObject("Wscript.Shell")
	On Error Resume Next
	RightClickEnabled = Eval("" <> ws.RegRead(strKey & "command\"))
End Function