vbscript - 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

score 1 · Accepted Answer

フォルダー、サブフォルダー、およびファイルのもつれを追跡できないことは認めます。ただし、フォルダー内のファイルの名前を変更する場合は、次の戦略を使用します。

  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 内のすべての (既存の) 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

アップデートⅡ

変更された仕様: .avi が 1 つだけある場合は、.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 を必要とするサブ/関数に渡すと、繰り返し再作成する必要がなくなります。
そのようなオブジェクトを処理する Subs/Functions に文字列の代わりにフォルダー/ファイルオブジェクトを渡すと、それらのプロパティ/メソッドにすぐに/無料でアクセスできます (文字列操作で情報を再利用/取得する必要はありません)。
ファイルの名前を変更する場合は、新しい名前のファイルがあるかどうかを確認する必要があります (使用するファイルに新しい名前がないかどうかを確認するだけでは十分ではありません)。

score 0 · Accepted Answer

理想的には、スクリプトには次の機能が必要です。

再帰 - 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

vbscript - VBSはファイルをフォルダ名と同じ名前に変更します

2 に答える 2

Related

Reference