VBS rename file to the same as a folder name - vbscript

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