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

<强>更新

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

更新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传递给需要的子/功能它，你避免重复的重复创作。
如果您将文件夹/文件对象而不是字符串传递给子/函数处理此类对象，您可以访问它们属性/方法立即/免费（无需回收/取回信息通过字符串操作）。
如果重命名文件，则必须检查是否有文件新名称（检查您使用的文件是否足够没有新名称。）。

Answer 2

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

递归 - 用于从D：\ Shared \ Films
重命名文件功能 - 根据您的规则重命名匹配文件。

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

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

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

2 个答案: