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

运行3次的输出：

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

更新

如何：给定文件夹 D 和文件名 F（例如 someavi.avi），将 D 及其子文件夹中的所有（现有）Fs 重命名为“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

更新 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

更新 III

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

Answer 2

理想情况下，您的脚本应具有以下功能：

• 递归 - 用于遍历 D:\Shared\Films 深度为 1-n 的文件夹
• 重命名文件功能 - 用于根据您的规则重命名匹配文件。

我编写了以下脚本，其中包含以下例程：

• 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