none
VBScript help on renaming folders and subfolders

    Question

  • The following script renames files by replacing the ampersand with 'and'.  How would you modify this code to rename folders as well?  Also, what if I wanted to take out '..' and replace with just one '.' by renaming?


    Dim fso

    ' create a global copy of the filesystem object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Call the RecurseFolders routine with name of function to be performed
    ' Takes one argument - in this case, the Path of the folder to be searched
    RecurseFolders ".", "RenameIt"

    ' echo the job is completed
    WScript.Echo "Completed!"

    Sub RecurseFolders(sPath, funcName)
    Dim folder

      With fso.GetFolder(sPath)
        if .SubFolders.Count > 0 Then
          For each folder in .SubFolders

             ' Perform function's operation
             Execute funcName & " " & chr(34) & folder.Path & chr(34)

             ' Recurse to check for further subfolders
             RecurseFolders folder.Path, funcName

          Next
        End if
      End With

    End Sub

    Sub RenameIt(folPath)
    Dim sName, fil

      ' go thru each file in the folder
      For Each fil In fso.GetFolder(folPath).Files

      ' check if the file name contains underscore
        If InStr(1, fil.Name, "&") <> 0 Then

      ' replace '&' with 'and'
          sName = Replace(fil.Name, "&", "and")
     
      ' rename the file
        fil.Name = sName

        End If
      Next
    end sub
    Thursday, October 01, 2009 2:23 PM

Answers

  • Sorry, I failed to paste everything into the post.  Add this ...

    Sub RenameFLDR(sFrom, sTo, folPath)
    Dim sName, oFldr

      set oFldr = fso.GetFolder(folPath)
      ' check if the file name contains the sFrom string
      If InStr(1, oFldr.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
        sName = Replace(oFldr.Name, sFrom, sTo)
     
      ' rename the file
        oFldr.Name = sName

      End If
    end sub

    Tom Lavedas
    • Marked as answer by Denniston Thursday, October 01, 2009 5:54 PM
    Thursday, October 01, 2009 4:21 PM
    Moderator

All replies

  • I wrote a renamer tool in JScript a while back for Windows IT Pro:

    http://windowsitpro.com/article/articleid/95072/

    It renames files and/or directories and supports regular expressions. It looks like the article is subscriber-only, but if it saves you time and money the subscription fee might be worth it.

    Bill
    Thursday, October 01, 2009 2:50 PM
    Moderator
  • I haven't fully tested this, but I think this will work ...

    Dim fso

    ' create a global copy of the filesystem object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Call the RecurseFolders routine with name of function to be performed
    ' Takes four arguments - the Path of the folder to be searched,
    '                        the name of the function to be executed,
    '                         the FROM string and the TO string
    RecurseFolders "..", "RenameIt", "&", "and"
    RecurseFolders "..", "RenameIt", "..", "."
    RecurseFolders "..", "RenameFLDR", "&", "and"

    ' echo the job is completed
    WScript.Echo "Completed!"

    Sub RecurseFolders(sPath, funcName, sfrom , sTo)
    Dim folder, sCmd

      With fso.GetFolder(sPath)
        if .SubFolders.Count > 0 Then
          For each folder in .SubFolders
             sCmd = funcName & " " _
                  & chr(34) & sFrom & chr(34) & "," _
                  & chr(34) & sTo   & chr(34) & "," _
                  & chr(34) & folder.Path & chr(34)

             ' Perform function's operation
             Execute sCmd

             ' Recurse to check for further subfolders
             RecurseFolders folder.Path, funcName, sfrom , sTo

          Next
        End if
      End With

    End Sub

    Sub RenameIt(sFrom, sTo, folPath)
    Dim sName, fil

      set oFldr = fso.GetFolder(folPath)
      ' go thru each file in the folder
      For Each fil In oFldr.Files

      ' check if the file name contains the sFrom string
        If InStr(1, fil.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
          sName = Replace(fil.Name, sFrom, sTo)
     
      ' rename the file
        fil.Name = sName

        End If

      Next
    end sub



    Tom Lavedas
    Thursday, October 01, 2009 3:35 PM
    Moderator
  • I get an Error

    Error: Type mismatch: 'RenameFLDR'
    Char: 1
    Line:  0
    Thursday, October 01, 2009 4:08 PM
  • Sorry, I failed to paste everything into the post.  Add this ...

    Sub RenameFLDR(sFrom, sTo, folPath)
    Dim sName, oFldr

      set oFldr = fso.GetFolder(folPath)
      ' check if the file name contains the sFrom string
      If InStr(1, oFldr.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
        sName = Replace(oFldr.Name, sFrom, sTo)
     
      ' rename the file
        oFldr.Name = sName

      End If
    end sub

    Tom Lavedas
    • Marked as answer by Denniston Thursday, October 01, 2009 5:54 PM
    Thursday, October 01, 2009 4:21 PM
    Moderator
  • That works great!  Is there a way to keep processing the script file even if errors occur - and to output errors in a text file?
    Thursday, October 01, 2009 8:58 PM
  • Have you experienced an error?  What was it? A judiciously placed ON ERROR RESUME NEXT statement can be used, but it is best to identify the likely source of the error to be able to handle (correctly log) the error.  It is never advisable to just blanket the script with it, so some knowledge of the errors that can occur is needed to place the error handling code in the right part of the code.

    As a pure guess, I might think that an attribute might cause an 'access denied' problem in renaming some files or folders, so this might be useful ...

    Sub RenameFLDR(sFrom, sTo, folPath)
    Dim sName, oFldr

      set oFldr = fso.GetFolder(folPath)
      ' check if the file name contains the sFrom string
      If InStr(1, oFldr.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
        sName = Replace(oFldr.Name, sFrom, sTo)
     
      on error resume next
      ' rename the file
        oFldr.Name = sName
      if err.number <> 0 then
        oLogFile.Writeline "Folder Error: " & err.number & ", " & err.description _
          & " renaming " & oFldr.Name
      end if

      End If
      ' the ON Error scope ends at end of sub
    end sub

    The same can be done at the end of the RenameIt routine.

    The oLogFile object is a file opened in the global context (at the Main program level), as in ...

    Dim oLogFile
    set oLogFile = fso.opentextfile("d:\somewhere\somename.log", 8, true)
    Tom Lavedas
    Tuesday, October 06, 2009 3:49 PM
    Moderator
  • Tom, thanks alot for your help.  This is what I got so far, including the script you put together above.  However, when I run this, I do get an error - but it doesn't output the error.  It does create a .log file, but nothing in it.  The error dialog that I get is this: 

    Line 54
    Char 5
    Error:  Permission Denied
    Code: 800A0046
    Source VBS Runtime Error

    Dim fso

    ' create a global copy of the filesystem object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Call the RecurseFolders routine with name of function to be performed
    ' Takes four arguments - the Path of the folder to be searched,
    '                        the name of the function to be executed,
    '                         the FROM string and the TO string
    RecurseFolders "..", "RenameIt", "&", "and"
    RecurseFolders "..", "RenameIt", "..", "."
    RecurseFolders "..", "RenameFLDR", "&", "and"

    ' echo the job is completed
    WScript.Echo "Completed!"

    Sub RecurseFolders(sPath, funcName, sfrom , sTo)
    Dim folder, sCmd

      With fso.GetFolder(sPath)
        if .SubFolders.Count > 0 Then
          For each folder in .SubFolders
             sCmd = funcName & " " _
                  & chr(34) & sFrom & chr(34) & "," _
                  & chr(34) & sTo   & chr(34) & "," _
                  & chr(34) & folder.Path & chr(34)

             ' Perform function's operation
             Execute sCmd

             ' Recurse to check for further subfolders
             RecurseFolders folder.Path, funcName, sfrom , sTo

          Next
        End if
      End With

    End Sub

    Sub RenameIt(sFrom, sTo, folPath)
    Dim sName, fil

      set oFldr = fso.GetFolder(folPath)
      ' go thru each file in the folder
      For Each fil In oFldr.Files

      ' check if the file name contains the sFrom string
        If InStr(1, fil.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
          sName = Replace(fil.Name, sFrom, sTo)
     
      ' rename the file
        fil.Name = sName

        End If

      Next
    end sub

    Sub RenameFLDR(sFrom, sTo, folPath)
    Dim sName, oFldr

      set oFldr = fso.GetFolder(folPath)
      ' check if the file name contains the sFrom string
      If InStr(1, oFldr.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
        sName = Replace(oFldr.Name, sFrom, sTo)
     
      ' rename the file
        oFldr.Name = sName

      End If
    end sub

    Sub RenameFLDR(sFrom, sTo, folPath)
    Dim sName, oFldr

      set oFldr = fso.GetFolder(folPath)
      ' check if the file name contains the sFrom string
      If InStr(1, oFldr.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
        sName = Replace(oFldr.Name, sFrom, sTo)
     
      on error resume next
      ' rename the file
        oFldr.Name = sName
      if err.number <> 0 then
        oLogFile.Writeline "Folder Error: " & err.number & ", " & err.description _
          & " renaming " & oFldr.Name
      end if

      End If
      ' the ON Error scope ends at end of sub
    end sub

    'The same can be done at the end of the RenameIt routine.

    'The oLogFile object is a file opened in the global context (at the Main program level), as in ...

    Dim oLogFile
    set oLogFile = fso.opentextfile("C:\documents and settings\jdenniston\desktop\characters.log", 8, true)
    Monday, October 12, 2009 1:59 PM
  • The code you posted didn't have the error trap in the RenameIT routine and duplicates the RenameFldr routine.

    Try this instead ...

    Dim fso

    ' create a global copy of the filesystem object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' create a global log file object
    Dim oLogFile
    sLogPathSpec = "C:\documents and settings\jdenniston\desktop\characters.log"
    set oLogFile = fso.opentextfile(sLogPathSpec, 8, true)

    ' Call the RecurseFolders routine with name of function to be performed
    ' Takes four arguments - the Path of the folder to be searched,
    '                        the name of the function to be executed,
    '                         the FROM string and the TO string
    RecurseFolders "..", "RenameIt", "&", "and"
    RecurseFolders "..", "RenameIt", "..", "."
    RecurseFolders "..", "RenameFLDR", "&", "and"

    ' echo the job is completed
    WScript.Echo "Completed!"

    Sub RecurseFolders(sPath, funcName, sfrom , sTo)
    Dim folder, sCmd

      With fso.GetFolder(sPath)
        if .SubFolders.Count > 0 Then
          For each folder in .SubFolders
             sCmd = funcName & " " _
                  & chr(34) & sFrom & chr(34) & "," _
                  & chr(34) & sTo   & chr(34) & "," _
                  & chr(34) & folder.Path & chr(34)

             ' Perform function's operation
             Execute sCmd

             ' Recurse to check for further subfolders
             RecurseFolders folder.Path, funcName, sfrom , sTo

          Next
        End if
      End With

    End Sub

    Sub RenameIt(sFrom, sTo, folPath) ' with error trapping added
    Dim sName, fil

      set oFldr = fso.GetFolder(folPath)
      ' go thru each file in the folder
      For Each fil In oFldr.Files

      ' check if the file name contains the sFrom string
        If InStr(1, fil.Name, sFrom) <> 0 Then

      '   replace sFrom with sTo
          sName = Replace(fil.Name, sFrom, sTo)
     
          on error resume next
      '   rename the File
          fil.Name = sName

          if err.number <> 0 then
            oLogFile.Writeline "Folder Error: " & err.number & ", " & err.description _
              & " renaming " & oFldr.Name
          end if

        End If

      Next
    end sub

    Sub RenameFLDR(sFrom, sTo, folPath) ' with error trapping added
    Dim sName, oFldr

      set oFldr = fso.GetFolder(folPath)
      ' check if the file name contains the sFrom string
      If InStr(1, oFldr.Name, sFrom) <> 0 Then

      ' replace sFrom with sTo
        sName = Replace(oFldr.Name, sFrom, sTo)
     
        on error resume next
      ' rename the Folder
        oFldr.Name = sName

        if err.number <> 0 then
          oLogFile.Writeline "Folder Error: " & err.number & ", " & err.description _
            & " renaming " & oFldr.Name
        end if

      End If
      ' the ON Error scope ends at end of sub
    end sub

    BTW, I am a bit frustrated in trying to offer a little help here.  I don't know quite how to say this gently enough, so just dial back what you read.  But to me, you don't seem to be applying much of your own effort into this.  Rather, you seem to be relying an awful lot on me to fix everything.  I don't believe that is the spirit of this forum.
    Tom Lavedas
    Monday, October 12, 2009 3:04 PM
    Moderator