0

是否可以使用 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
4

2 回答 2

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

更新

怎么样：给定一个文件夹 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

更新二

更改规格：将 .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

更新三

  • 如果您使用全局 FSO 或将 FSO 传递给需要它的 Subs/Function，则可以避免重复重新创建它。
  • 如果您将文件夹/文件对象而不是字符串传递给处理此类对象的 Subs/Function，则可以立即/免费访问它们的属性/方法（无需通过字符串操作回收/取回信息）。
  • 如果重命名文件，则必须检查是否存在具有新名称的文件（仅检查您使用的文件是否没有新名称是不够的）。
于 2012-06-16T23:42:04.607 回答
0

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

  • 递归 - 用于遍历 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
于 2012-06-19T12:25:28.303 回答