作ってみた

ファイル名の一部を置換するvbスクリプト。Windows2000、XPは動作する。Vistaは未確認です。


下にあるコードをメモ帳にコピペして、上部メニューから「ファイル名を指定して保存」
ダイアログの「ファイルの種類」を「すべてのファイル」にし、ファイル名をReplaceFilename.vbsで保存。


で、そのVBSのReplaceFilename.vbsアイコンにファイル名を置換したいファイルをドラッグ＆ドロップすると
入力窓が二回出て、1回目は置き換えたい文字、2回目がその文字を何に置き換えるかを入力する。


さらに、複数ファイル同時に可能。（というかそれがメイン）
10個まとめてファイルコピーしてファイル名の先頭に「コピー 〜」って付いたのを、「old」に置き換えたりできちゃいます。


あまりエラーチェックを入れてないので、ファイル名に使えない文字とかも入力できますが、そのままエラー吐いて落ちます。
このコードを使って発生したことに責任負いかねますのでご了承ください。


以下から全部がコード

' このファイルにドラッグ&ドロップされたファイルのファイル名を入力に応じて置換する。
' 例）000-Filename.txt → 111-Filename.vbs
' 複数のファイルの場合、全ファイルで同じ置換処理が実行される。
' 起動引数の文字列制限を受けるため、フルパスで一定文字列以上のファイル数は受け入れられない
' フォルダ名の変更は不可。(再帰処理でフォルダを遡って作り直すとか無理なんで対象外です)


' ファイル名の接頭につけるナンバリング変更対応のため、即興で作成した物を少し汎用化してツールにしてみた
' ってか後から変えんじゃね、全部ファイル作り終わった後に言うな、数が多くて大変なんだよ、等のストレスから解放してくれます
' Author Inja 2009/5/15

Dim objFSO          ' FileSystemObject
Dim lngLoop         ' ループカウンタ
Dim newname         ' 置換済みファイル名
Dim oldname         ' 置換元ファイル名
Dim before          ' 置換元文字列
Dim after           ' 置換先文字列
Dim fileObj         ' Fileオブジェクト
Dim continueFlag    ' 処理継続フラグ

' ユーザ入力
' 置換前入力
before = InputBox("ファイル名から消したい文字列を入力" , "削除/置換元文字列入力", "コピー 〜 ")
if len(before) < 1 then 
  MsgBox "処理を中止します"
  WScript.Quit
end if

' 置換後入力 キャンセル(0)入力の場合、置換前文字列削除の処理になる。
after = InputBox("消した文字列の代わりに入れる文字列を入力してください" , "追加/置換先文字列入力", before )

' 置換内容確認
continueFlag = MsgBox (before & Chr(13)&Chr(10) & "   ↓       " &Chr(13)&Chr(10) & after , vbOKCancel, "以下のように置換します")
if not continueFlag = vbOK then
  MsgBox "処理を中止します"
  WScript.Quit
end if

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

' WScript.Echo "引数として渡されたファイルは" & WScript.Arguments.Count & "個あります。"

For lngLoop = 0 To WScript.Arguments.Count - 1
    Set fileObj = objFSO.GetFile(WScript.Arguments.Item(lngLoop))
    newname = fileObj.name
    oldname = fileObj.name
    newname =Replace( newname, Cstr(before), Cstr(after))

    objFSO.MoveFile fileObj.ParentFolder & "\" & oldname, fileObj.ParentFolder & "\" & newname
Next