VBS 「ファイル名の変更」: 長く曲がりくねった道　～　いろいろな話

2015年05月23日

VBS 「ファイル名の変更」

ブログを書いていて一つ面倒な作業がある。
画像が大きいのでサイズダウンしてアップしている訳だが、
サイズダウンしたファイルの名前を変更しておかなければならい。
変更しておかないと後でどれがオリジナルなのか解らなくなる。
そこでひとつひとつ名前を変更するわけだが、
ファイル数が多いと大変だ。
そこでファイル名の変更をVBSで作ってみた。
VBSとは、Visual Basic Script 。
ビジュアルベーシックふうのスクリプトで、簡易に処理が出来る。
昔、DOSコマンドで原始的な作業をバッチ処理していたが、
その作業をスクリプトで行えるのだ。
"FileSystemObject"と言うオブジェクトをよく使うので、
覚えるといいだろう。
下記が処理ソースだ。
コメントにも入れてあるが、出来上がったスクリプトを処理したい
フォルダに配置し実行すればファイル名を変更する。
単一フォルダ内のみの処理なので、下位レベルまで処理したければ
改造が必要となる。
ダイアログを出してフォルダの指定をしても良いのだが、
使用頻度から考えるとそこまでは必要ないと判断した。
コンスタントパラメータ"cFiExt"に処理したいファイルの
拡張子を入れておけば、該当するファイルだけリネームする。
被検査対象を小文字に変換してから判断しているので、
コンスタントは小文字で設定する。
結果をMsgBoxで表示しているが、MsgBoxにも表示制限があって、
文字数は1バイト文字で最大約1024文字までしか表示出来ない。
メインルーチンでスクリプトの入っているフォルダを判断し、
関数でファイル名の変更ルーチンを呼び出している。
関数を変えれば他にもいろいろ使うことが出来る。
例えば、ファイルのコピーとか移動とか削除とか。

'=======================================
'ﾌｫﾙﾀﾞ単位の名前の変更を行う
'対象ﾌｫﾙﾀﾞにこのｽｸﾘﾌﾟﾄを配置し、ｽｸﾘﾌﾟﾄを実行する
'処理対象拡張子をcFiExtに入力しておく
'=======================================
'
'ﾌｫﾙﾀﾞ名にｽﾍﾟｰｽ等が入っているとｴﾗｰになる
'MsgBoxは1ﾊﾞｲﾄ文字で最大約1024文字までしか表示出来ない
'
Const cFiExt = "jpggif" 'jpg と gif を処理対象にする
dim FS
dim xMyPath

set FS=CreateObject("Scripting.FileSystemObject")
'ｽｸﾘﾌﾟﾄのﾌｫﾙﾀﾞ名を取得
xMyPath=Replace(WScript.ScriptFullName, WScript.ScriptName, vbNullString)
if right(xMyPath,1)="\" then '右端が"\"の場合この"\"を削除
   xLen=Len(xMyPath)
   xMyPath=left(xMyPath,(xLen-1))
end if

FileRenameProc(xMyPath)

set FSN = Nothing

'--------------------------------------------------
'　ﾌｧｲﾙ名の変更
'--------------------------------------------------
Function FileRenameProc(pSourceFolder)
dim objFolder,objFiles,objFi,Fi
dim Arr,xx,tmp,NewName
dim xLen,Ix

Set objFolder = FS.GetFolder(pSourceFolder)
Set objFiles = objFolder.Files
tmp = ""
For Each Fi in objFiles
   Arr =Split(Fi.Name,".")
   xx = LCase(Arr(1))
   If InStr(cFiExt,xx) > 0 Then
      set objFi = FS.GetFile(Fi)
      NewName=Arr(0) & "b" & "." & Arr(1)
      tmp = tmp & Fi.name & "->" & NewName & vbCrLf

      objFi.Name = NewName

   End If
Next
MsgBox tmp '表示文字数制限あり

set objFi = Nothing
Set objFiles = Nothing
Set objFolder = Nothing

End Function

【このカテゴリーの最新記事】