VBS rename file to the same as a folder name

Question

Is it possible to rename a file in a folder to its folder name using vbs? I have the following script which I am just using MsgBox at this time for debugging before I implement the renaming. for some reason tho ObjFolder doesnt change.

Option Explicit
Dim strFolderToSearch, objFSO, objRootFolder, objFolder, colSubfolders, strOutput, objStartFolder, colFiles, objFile

strFolderToSearch = "D:\Shared\Films"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(strFolderToSearch)
Set colSubfolders = objRootFolder.SubFolders

For Each objFolder in colSubfolders

objStartFolder = objFolder
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files

For Each objFile in colSubfolders
MsgBox objFile.name & "," & objFolder.name
Next
Next

Answer 1

I admit that I can't follow the tangle of your folders, subfolders, and files. But if you want to rename files in a folder, use this stratege:

  Dim sDName  : sDName  = "FancyRename"
  Dim sDName2 : sDName2 = "," & sDName
  Dim oFile, sNewName
  For Each oFile In goFS.GetFolder(goFS.BuildPath("..\testdata", sDName)).Files
      If 0 = Instr(oFile.Name, sDName2) Then
         sNewName = Replace(oFile.Name, ".", sDName2 & ".")
      Else
         sNewName = Replace(oFile.Name, sDName2, "")
      End If
      WScript.Echo oFile.Name, "=>", sNewName
      oFile.Name = sNewName
  Next

output of running this three times:

that.txt => that,FancyRename.txt
this.txt => this,FancyRename.txt

that,FancyRename.txt => that.txt
this,FancyRename.txt => this.txt

that.txt => that,FancyRename.txt
this.txt => this,FancyRename.txt

UPDATE

How about: Given a folder D and a file name F (e.g. someavi.avi), rename all (existing) Fs in D and its sub folders to "subfoldername.avi", unless such a file already exists:

recursiveRename goFS.GetFolder("..\testdata\FancyRename"), "someavi", "avi"

Sub recursiveRename(oDir, sFiNa, sExt)
  WScript.Echo "Looking into", oDir.Path
  Dim sOFiNa  : sOFiNa  = sFiNa & "." & sExt
  Dim sOFSpec : sOFSpec = goFS.BuildPath(oDir.Path, sOFiNa)
  Dim sNFSpec
  If goFS.FileExists(sOFSpec) Then
     WScript.Echo "found ", sOFSpec
     sNFSpec = goFS.BuildPath(oDir.Path, oDir.Name & "." & sExt)
     If goFS.FileExists(sNFSpec) Then
        WScript.Echo "found ", sNFSpec, "- can't rename"
     Else
        WScript.Echo "found no", sNFSpec, "- will rename"
        goFS.MoveFile sOFSpec, sNFSpec
     End If
  Else
     WScript.Echo "found no", sOFSpec
  End If

  Dim oSubF
  For Each oSubF In oDir.SubFolders
      recursiveRename oSubF, sFiNa, sExt
  Next
End Sub

sample output:

Looking into M:\lib\kurs0705\testdata\FancyRename
found no M:\lib\kurs0705\testdata\FancyRename\someavi.avi
Looking into M:\lib\kurs0705\testdata\FancyRename\subfa
found no M:\lib\kurs0705\testdata\FancyRename\subfa\someavi.avi
Looking into M:\lib\kurs0705\testdata\FancyRename\subfc
found  M:\lib\kurs0705\testdata\FancyRename\subfc\someavi.avi
found no M:\lib\kurs0705\testdata\FancyRename\subfc\subfc.avi - will rename
Looking into M:\lib\kurs0705\testdata\FancyRename\subfb
found  M:\lib\kurs0705\testdata\FancyRename\subfb\someavi.avi
found  M:\lib\kurs0705\testdata\FancyRename\subfb\subfb.avi - can't rename

UPDATE II

Changed specs: rename .avi to folder name, if there is exactly one .avi

recursiveRename03 goFS.GetFolder("..\testdata\FancyRename")


Sub recursiveRename03(oDir)
  WScript.Echo "Looking into", oDir.Path
  Dim sNFSpec : sNFSpec = goFS.BuildPath(oDir.Path, oDir.Name & ".avi")
  If goFS.FileExists(sNFSpec) Then
     WScript.Echo "found ", sNFSpec, "- can't rename"
  Else
     Dim oOFile  : Set oOFile = Nothing
     Dim oFile
     For Each oFile In oDir.Files
         If "avi" = goFS.GetExtensionName(oFile.Name) Then
            If oOFile Is Nothing Then
               Set oOFile = oFile
            Else
               WScript.Echo "Found second avi", oFile.Name
               Set oOFile = Nothing
               Exit For
            End If
         End If
     Next
     If oOFile Is Nothing Then
        WScript.Echo "not exactly one avi found"
     Else
        WScript.Echo "found ", oOFile.Name, "- will rename"
        oOFile.Name = oDir.Name & ".avi"
     End If
  End If

  Dim oSubF
  For Each oSubF In oDir.SubFolders
      recursiveRename03 oSubF
  Next
End Sub

UPDATE III

• If you use a global FSO or pass an FSO to the Subs/Functions needing it, you avoid its repetitive re-creation.
• If you pass a folder/file object instead of a string to the Subs/Functions dealing with such objects, you can access their properties/methods immediately/for free (no need to reclaim/get back info by string operations).
• If you rename a file, you must check whether there is a file having the new name (it's not sufficient to check whether the file you work with doesn't have the new name).

Answer 2

Idealistically, your script should have the following features:

• Recursion - For traversing folders that are 1-n deep from D:\Shared\Films
• Rename file function - For renaming match files according to your rule.

I wrote the following script that features the following routines:

• RenameAllVideos(strFolder) - this will recursively search subfolders
• RenameVideo(strFileName) - will rename a match video file using your rule

Here's my script:

Option Explicit

Call RenameAllVideos("D:\Shared\Films")

Sub RenameAllVideos(strFolder)
  Dim fso, file, folder
  Set fso = CreateObject("Scripting.FileSystemObject")

  ' Check for AVIs to rename.
  For Each file in fso.GetFolder(strFolder).Files
    If Right(file.Name, 4) = ".avi" Then
      Call RenameVideo(strFolder & "\" & file.Name)
    End If
  Next

  ' Check for SubFolders to recurse into.
  For Each folder in fso.GetFolder(strFolder).SubFolders
    Call RenameAllVideos(strFolder & "\" & folder.Name)
  Next
End Sub

Sub RenameVideo(strFileName)
  Dim fso, strExt, strFolder, strNewFileName
  Set fso = CreateObject("Scripting.FileSystemobject")

  ' Note the extension (should be avi)
  strExt = fso.GetExtensionName(strFileName)

  ' Derive the full path to the folder.
  strFolder = fso.GetParentFolderName(strFileName)

  ' Derive the new filename.
  strNewFileName = strFolder & "\" & fso.GetBaseName(strFolder) & "." & strExt

  ' Do the rename.
  If strFileName <> strNewFileName Then
    WScript.Echo "Renaming " & strFileName & " to " & strNewFileName
    fso.MoveFile strFileName, strNewFileName
  End If
End Sub