Option Explicit
'On Error Resume Next
'Does a recursive removal of spaces from all file names
'in and below a given directory
'Written by Eric Phelps http://www.ericphelps.com

'Force "cscript"
Main
Wscript.Quit 0

Sub Main()
Dim fil 'As Scripting.File
Dim fils 'As Scripting.Files
Dim fol 'As Scripting.Folder
Dim fols 'As Scripting.Folders
Dim fs 'As Scripting.FileSystemObject
Dim strDirectories() 'As String
Dim lngCounter 'As Long
Dim strOldText 'As String
Dim strNewText 'As String
Const READONLY = 1
Const HIDDEN = 2
Const SYSTEM = 4
	If MsgBox ("This program will remove all spaces from file names in and below a directory you designate. Continue?", vbOkCancel) = vbCancel Then Wscript.Quit
	Set fs = CreateObject("Scripting.FileSystemObject")
	If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then 
		If MsgBox ("This program is being run under WSCRIPT. Results will be stored in a log at " & Wscript.ScriptFullName & ".log" & ". Run this program under CSCRIPT if you want a real-time display of activity. Otherwise, a message box will pop up to inform you when the program finishes. Continue?", vbOkCancel, "No Spaces") = vbCancel Then Wscript.Quit
	Else
		If MsgBox ("This program is being run under CSCRIPT. Results will be displayed on-screen and will not be logged. Run this program under WSCRIPT if you want a log file. Continue?", vbOkCancel, "No Spaces") = vbCancel Then Wscript.Quit
	End If
	Redim strDirectories(0)
	strDirectories(0) = fs.GetAbsolutePathName(InputBox("Enter path to start recursively removing spaces from file names:", "No Spaces", FileNameInThisDir("")))
	If strDirectories(0) = "" Then Wscript.Quit
	lngCounter = 0
	Status "*************************************"
	Status "*************************************"
	Status "Program: " & Wscript.ScriptFullName
	Status "Removing spaces in and below: " & strDirectories(0)
	Status "Starting Time: " & Now
	Do Until lngCounter > Ubound(strDirectories,1)
		'Next folder to process
		Set fol = fs.GetFolder(strDirectories(lngCounter))
		'Get each file in turn
		Set fils = fol.Files
		If Err.Number <> 0 Then Exit Sub
		For Each fil In fils
			If (Instr(fil.Name, " ") <> 0) Then
				Status fil.Path
				If ((fil.Attributes And READONLY) = 0) Then
					If ((fil.Attributes And SYSTEM) = 0) Then
						If ((fil.Attributes And HIDDEN) = 0) Then
							RemoveSpaces fil
						Else
							Status "	HIDDEN"
						End If
					Else
						Status "	SYSTEM"
					End If
				Else
					Status "	READONLY"
				End If
			End If
		Next
		'Check for any sub folders and add them to the folder array
		Set fols = fol.SubFolders
		For each fol in fols
			If Lcase(fol.Name) <> "recycled" Then
				Redim Preserve strDirectories(Ubound(strDirectories,1) + 1)
				strDirectories(Ubound(strDirectories,1)) = fol.Path
			End If
		Next
		lngCounter = lngCounter + 1
	Loop
	Status "Program finished: " & Now
	Status "*************************************"
	Status "*************************************"
	If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then MsgBox "Program Finished! Details are in the log at " & Wscript.ScriptFullName & ".log", vbOkOnly, "No Spaces"
End Sub

Function FileNameInThisDir(strFileName) 'As String
'Returns the complete path and file name to a file in
'the script directory. For example, "trans.log" might
'return "C:\Program Files\Scripts\Database\trans.log"
'if the script was in the "C:\Program Files\Scripts\Database"
'directory.
Dim fs 'As Scripting.FileSystemObject
	Set fs = CreateObject("Scripting.FileSystemObject")
	 FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName))
	''''''''''Clean up
	Set fs = Nothing
End Function

Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a
'line into the DOS box. If run with WSCRIPT, it writes
'to a log in the same directory as the script.
Dim ts 'As Scripting.TextStream
Dim fs 'As Scripting.FileSystemObject
Const ForAppending = 8 'Scripting.IOMode
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then 
		Wscript.Echo strMessage
	Else
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".log", ForAppending, True)
		ts.WriteLine strMessage
		ts.Close
		''''''''''Clean up
		Set ts = Nothing
		Set fs = Nothing
	End If
End Sub

Sub Force(sScriptEng)
'Forces this script to be run under the desired scripting host
'Valid sScriptEng arguments are "wscript" or "cscript"
'If you don't supply a valid name, Force will switch hosts...
	If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
		'Running under WSCRIPT
		If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
			'Need to switch to CSCRIPT
			CreateObject("Wscript.Shell").Run "cscript.exe " & Wscript.ScriptFullName
			Wscript.Quit
		End If
	Else
		'Running under CSCRIPT
		If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
			'Need to switch to WSCRIPT
			CreateObject("Wscript.Shell").Run "wscript.exe " & Wscript.ScriptFullName
			Wscript.Quit
		End If
	End If
End Sub

Sub RemoveSpaces(objScriptingFile)
Dim strFileName 'As String
	strFileName = objScriptingFile.Name
	If Instr(strFileName, " ") = 0 Then Exit Sub
	Do While Instr(strFileName, " ") <> 0
		strFileName = Left(strFileName, Instr(strFileName, " ") -1) & Mid(strFileName, Instr(strFileName, " ") + 1)
	Loop
	'Sometimes removing a space isn't recognized properly, so change to intermediate name first
	objScriptingFile.Name = "-RecursiveNoSpaces-" & strFileName
	objScriptingFile.Name = strFileName
	Status "	>" & objScriptingFile.Name
End Sub