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