Replace Spaces in File and Folder Names with Underscores

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Replace Spaces in File and Folder Names with Underscores

Logged in as: Guest

arrSession:exec spGetSession 2,16,48607

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Replace Spaces in File and Folder Names with Underscores
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Replace Spaces in File and Folder Names with Underscores - 6/21/2007 12:57:29 PM

prodonjs

Posts: 3
Score: 0
Joined: 6/19/2007
Status: offline

I found this script to be necessary when I started dual booting between Linux and Windows. I got into the bad habit of using spaces often in my filenames and that's a big no-no if you're working from the console in Linux. It really makes things complicated. This should be pretty thorough and self-explanatory from my documentation.

' This script takes a directory as a parameter. That directory is then recursively scanned.
' The program removes all spaces from Folder names and replaces them with underscores
' For Files, it replaces the spaces with underscores, capitalizes the filename extension, and
' also formats the capitalization of any articles within the name.
' Version 1.0
' May 16th, 2007
' Jason Prodonovich
Const PROG_SUCCESS = 0
Const PROG_ERROR = 1
' Global data for the script
Dim objFSO, objBaseDir, objLogFile
Dim iArgCount, iArgPosition
Dim sDirToScan, sLogFilePath
Dim bTestMode, bVerboseMode, bCapExtensions, bLogMode
Set objFSO = CreateObject("Scripting.FileSystemObject")
iArgCount = WScript.Arguments.Count
iArgPosition = 0
' Initialize parameter control variables to false
bTestMode = False
bVerboseMode = False
bLogMode = False
bCapExtensions = False
'Ensure that we have at least one argument (the directory to be scanned) then parse all arguments
If iArgCount = 0 Then
ShowUsage()
Fail("Must specify a directory name")
Else
'Name of the path must be the first argument given
Dim pathName
pathName = WScript.Arguments(0)
InitializeBaseDirectory(pathName)

'Increment to look at the next argument
iArgPosition = iArgPosition + 1
HandleAdditionalArguments()
End If
' Begin the scan of the base-directory
Set objBaseDir = objFSO.GetFolder(sDirToScan)
OutputVerbose("Begin scanning " & sDirToScan & " on " & Now & vbCrLf & _
   "Test Mode: " & bTestMode & vbCrLf & _
   "Verbose Mode: " & bVerboseMode & vbCrLf & _
   "Log Mode: " & bLogMode & vbCrLf & _
   "Capitalize File Extensions: " & bCapExtensions & vbCrLf)
ScanAndReplace(objBaseDir)
'Script has completed, dispose of all objects, write final message
Set objFSO = Nothing
Set objBaseDir = Nothing
'If a log file exists, write the final line and close it
OutputVerbose("Finished scanning " & sDirToScan & " on " & Now)
If Not IsEmpty(sLogFilePath) Then objLogFile.Close
' Exit the script (if we made it here without error, script was successful)
WScript.Quit(PROG_SUCCESS)
' ======================================== Locally used Functions and Subroutines ========================================
' SUBROUTINES
' Starts at the specified folder and recursively looks through any sub-folders to replace spaces
Sub ScanAndReplace(fFolderToScan)
'Continue running if we encounter an error in this routine
On Error Resume Next

Dim iFileCount, iSubFolderCount
Dim filesInFolder, subFoldersInFolder

'Initialize the files and subfolders objects from the File and Folder Collection properties of the base folder
Set filesInFolder = fFolderToScan.Files
Set subFoldersInFolder = fFolderToScan.SubFolders

iFileCount = filesInFolder.Count
iSubFolderCount = subFoldersInFolder.Count

'Catch a FilePermissions error when trying to access properties of the current folder
If Err.Number = 70 Then
OutputVerbose(vbCrLf & "Sorry, you do not have permissions to modify " & fFolderToScan.Path & "!")
Else
OutputVerbose(vbCrLf & fFolderToScan & " has: " & iFileCount & " files, " & _
    iSubFolderCount & " folders")

'Need to recursively look into each sub-folder to see if files need to be renamed there
For Each folder in subFoldersInFolder
 'First, rename any subfolders that have spaces in their names
 Dim sFName, newName
 sFName = folder.Name
 OutputVerbose(vbTab & "Directory " & sFName)
 
 newName = ReplaceSpaces(sFName)
 
 If (Not bTestMode And StrComp(sFName, newName) <> 0) Then
  'Perform the actual renaming of the folder
  folder.Name = newName
  OutputVerbose(vbTab & vbTab & "has been changed to " & newName)
 ElseIf(bTestMode And StrComp(sFName, newName) <> 0) Then
  OutputVerbose(vbTab & vbTab & "WOULD BE CHANGED to " & newName)
 End If
 
 'Now recursively check this folder for files or subfolders
 ScanAndReplace(folder)
Next

'Need to examine each file in the folder and rename them appropriately
For Each file In filesInFolder
 Dim sName
 sName = file.Name
 OutputVerbose(vbTab & sName)
 
 newName = FormatInnerCaps(sName)
 newName = ReplaceSpaces(newName)
 
 ' If \E flag was set, capitalize the filename extension
 If bCapExtensions Then
  newName = CapitalizeExtension(newName)
 End If
 
 If (Not bTestMode And StrComp(sName, newName) <> 0) Then
  'Perform the actual renaming of the file
  'First make it blank (then recreate it to avoid the File Already Exists problem when we just change extension capitals)
  file.Name = "null"
  file.Name = newName
  OutputVerbose(vbTab & vbTab & "has been changed to " & newName)
 ElseIf(bTestMode And StrComp(sName, newName) <> 0) Then
  OutputVerbose(vbTab & vbTab & "WOULD BE CHANGED to " & newName)
 End If     
Next

End If
End Sub
' Tracks the output of the program whenever the user passes the /V option
Sub OutputVerbose(sMessage)
If bVerboseMode Then
If (IsObject(objLogFile) And bLogMode) Then 
 objLogFile.WriteLine("- " & sMessage)
End If
WScript.Echo ("- " & sMessage)
End If 
End Sub
' Sets up the starting location for the script to begin the renaming of files and folders
Sub InitializeBaseDirectory(sDirectoryLocation)
'If the folder is a valid location, save it to sDirToScan
If objFSO.FolderExists(sDirectoryLocation) Then
sDirToScan = sDirectoryLocation  
Else
Fail("Sorry, " & sDirectoryLocation & " does not exist ")
End If 
End Sub
Sub HandleAdditionalArguments()
Dim sNextArg

' If we still have arguments to process, process this one then call HandleAdditionalArguments() again
If (iArgPosition < iArgCount) Then
sNextArg = NextArgument(iArgPosition)
Select Case UCase(sNextArg)
       Case "/T" : bTestMode = True
       Case "/V" : bVerboseMode = True
 Case "/E" : bCapExtensions = True
       Case "/L" : bLogMode = True
  'Set up the log file as a text file within the directory of the script
  sLogFilePath = objFSO.GetAbsolutePathName("") & "\rename_log.TXT"    
  Set objLogFile = objFSO.CreateTextFile(sLogFilePath, True)
  bVerboseMode = True
       Case Else 
  Fail("Invalid option flag: " & sNextArg & vbCrLf & _
    "Run script with no parameters to view usage")             
   End Select
'Look to the next argument and recursively call
iArgPosition = iArgPosition + 1
HandleAdditionalArguments()  
End If
End Sub
' Prints the error message specified in sMessage when the program does not complete successfully
Sub Fail(sMessage)
If IsObject(objLogFile) Then 
objLogFile.WriteLine(WScript.ScriptName & ": " & sMessage)
objLogFile.Close
End If
WScript.Echo (WScript.ScriptName & ": " & sMessage)
WScript.Quit(PROG_ERROR)
End Sub
' Displays the syntax to be used when calling this script
Sub ShowUsage()
WScript.Echo ("Usage Conventions:" & vbCrLf & vbCrLf & _
   "format_filenames DIRECTORY_NAME [parameter list]" & vbCrLf & _
   "Valid Parameters:" & vbCrLf & _
   "/T - Test Mode" & vbCrLf & vbTab & _
   "No actual modification of files and folders" & vbCrLf & _
   "/E - Capitalize Extensions Mode" & vbCrLf & vbTab & _
   "Capitalizes the filename extensions" & vbCrLf & _
   "/V - Verbose Mode" & vbCrLf & vbTab & _
      "Print detailed information to the console and log file (if applicable)" & vbCrLf & _
      "/L - Log Mode" & vbCrLf & vbTab & _
   "Implies /V, prints information to a log file within the directory of the script")     
End Sub
' FUNCTIONS
' Grabs the name of the given file, searches it for empty spaces and replaces those with underscores
Function ReplaceSpaces(sFileName)
Dim newFileName
newFileName = sFileName

'Use the replace function to replace the " " character with the "_"
If (InStr(sFileName, " ") <> 0) Then
newFileName = Replace(sFileName, " ", "_")
End If

'Return from the Function
ReplaceSpaces = newFileName
End Function 
'Capitalize the extension at the end of the file
Function CapitalizeExtension(sFileName)
Dim newFileName, ext
Dim extensionPos
newFileName = sFileName

extensionPos = InStr(sFileName, ".")
'If extensionPos is zero, then the file has no extension
If Not extensionPos = 0 Then
'Extension's length is string's length - extensionPos
ext = Right(newFileName, Len(NewFileName) - extensionPos)
newFileName = Left(newFileName, extensionPos)

'Make the extension upper-case
ext = UCase(ext)

newFileName = newFileName & ext
End If
CapitalizeExtension = newFileName
End Function
'Examines the filename and ensures that no articles or common prepositional phrases get capitalized
Function FormatInnerCaps(sFileName)
Dim newFileName, firstLetter, rightSide
Dim articleArray
Dim articlePos
newFileName = sFileName

' List of the articles and prepositions that we will ensure are lowercase
articleArray = array("The ", "And ", "A ", "An ", "Or ", "With ", "From ", "In ", "On ", "Is ")

For Each word In articleArray
'Start after the first letter (since we want to leave the first word capitalized)
articlePos = InStr(2, sFileName, word)
If (articlePos <> 0) Then
 'We found the article, now make sure it is lowercased
 newFileName = SeparateStringAndLCaseArticles(newFileName, articlePos)
End If
Next

FormatInnerCaps = newFileName
End Function
' Splits the string into pieces so that an article contained in it can be sent to lowercase while making no other changes to the string
Function SeparateStringAndLCaseArticles(sFileName, iArticlePos)
Dim newFileName, leftPiece, lCaseArticle, rightPiece
newFileName = sFileName

'Separate the string into the piece left of the article, the article itself, and the piece to the right of the article
leftPiece = Left(sFileName, iArticlePos - 1)
lCaseArticle = LCase(Mid(sFileName, iArticlePos, 1))
rightPiece = Mid(sFileName, iArticlePos + 1)

'Concatenate the three pieces together before returning
newFileName = leftPiece & lCaseArticle & rightPiece

SeparateStringAndLCaseArticles = newFileName
End Function
' Returns the argument at iArgPos
Function NextArgument(iArgPos)
Dim sNextArgument
sNextArgument = WScript.Arguments(iArgPos)

NextArgument = sNextArgument 
End Function

EDIT(EBGREEN): Code tags are your friend.

< Message edited by ebgreen -- 6/22/2007 1:54:06 AM >

Revisions: 1 | Post #: 1

RE: Replace Spaces in File and Folder Names with Unders... - 6/22/2007 8:44:53 AM

Fredledingue

Posts: 337
Score: 0
Joined: 5/9/2005
From:
Status: offline

The main line on this script is Replace(file.name ," ","_")
Beside that everything is personal options but it's an interresting one.

If you want you can to check one similar script of mine: Go here
http://www.geocities.com/fredledingo/vbscripts.htm
and scroll down to FixFileName 7.0

Actualy it replaces dots by undrscores. Especialy useful to have regular, dos-looking names in your Favorite folder.
It can be easily changed to replace white space by _.

You may be interrested by the set of safeguards for the system folders.

I noticed that you work with extentions without using the
objFSO.GetExtensionName(file) method ...

_____________________________

Fred

(in reply to prodonjs)

Post #: 2

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> Post a VBScript >> Replace Spaces in File and Folder Names with Underscores

Page: [1]

Jump to:

New Messages	No New Messages
Hot Topic w/ New Messages	Hot Topic w/o New Messages
Locked w/ New Messages	Locked w/o New Messages

Post New Thread

Reply to Message

Post New Poll

Submit Vote

Delete My Own Post

Delete My Own Thread

Rate Posts