VBS将文件重命名为与文件夹名称相同

Question

是否可以使用vbs将文件夹中的文件重命名为其文件夹名称？在执行重命名之前，我有下面的脚本，我现在只是使用MsgBox进行调试。由于某种原因，ObjFolder不会改变。

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

我承认我无法跟踪您的文件夹，子文件夹和文件的纠结。但是，如果你想有一个文件夹中重命名文件，使用此战略 - ：

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 

运行了三次输出：

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

如何：给定一个文件夹d和文件名F（例如someavi.avi），将D及其子文件夹中的所有F（现有）F重命名为“subfoldername.avi”，除非这样的文件已存在：

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 

输出样本：

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

变更规格：重命名的.avi到文件夹的名称，如果恰好有一个的.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

• 如果您使用全局FSO或将FSO传递给需要 的子/函数，则可避免其重复重新创建。
• 如果您将文件夹/文件对象而不是字符串传递到处理此类对象的子/函数，则可以立即/免费访问它们的 属性/方法（不需要通过字符串回收/取回 信息操作）。
• 如果您重新命名一个文件，您必须检查是否有一个名称为 的文件（这不足以检查您使用 的文件是否没有新名称）。

Answer 2

理想化，你的脚本应该具有以下特点：

• 递归 - 遍历是1-N深自d文件夹：\共享\电影
• 重命名文件的功能 - 重命名比赛文件根据您的规则。

我写了下面的脚本，具有以下程序：

• RenameAllVideos（strFolder） - 这将递归搜索子文件夹
• RenameVideo（strFileName） - 将使用您的规则命名比赛的视频文件

这里是我的脚本：

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