ファイル名＋3桁連番リネーマ(vbs)：遊ぶ大人の非常識 by きのこ組：SSブログ

	ブログをはじめるログイン

ファイル名＋3桁連番リネーマ(vbs)　[スクリプト言語など] [編集]

リネームしたいファイルを、このVBSファイルへ「ドラッグ&ドロップ」すると、同じフォルダー内の同じ拡張子のファイル全てを対象に、リネームを実行します。

VBSファイルの作り方は、例によって下のエリアのソースを「新規テキストファイル」へ丸ごとコピーし、「○○○.VBS」と変名保存するだけです。

現在、異様に時間がかかることがあるエラー問題を検討中ですが、デジカメ画像整理に威力を発揮してくれてます。_ ( _ ^ _ ; ) _

Set objArgs = WScript.Arguments
    For I = 0 to objArgs.Count - 1
    PS = objArgs(I)
Next

Dim fso, f,f1,fc, s, EXN,z,zz,URN,PF,PFF
 Set fso = CreateObject("Scripting.FileSystemObject")
 EXN = fso.GetExtensionName(PS)
if EXN = "" Then
  i = msgbox("「拡張子付のファイル」をドロップしてくださいませ!!",,"★ えら～どすえ")
Else
 pn = InstrRev(PS,"\")
 PFF = Left(PS, pn)
 AIU = "NewFileName"

URN = InputBox(PFF & " にある " &  Ucase(EXN) & " ファイルを「 テキスト名＋000～999 」の連番でリネームします。?!", Ucase(EXN) &" ファイルのリネームだよ～んだぁ。!!",AIU)

Set f = fso.GetFolder(PFF)
 Set fc = f.Files
 s=0

If URN="" Then
   msgbox "・・きゃんせるしたよぉ!!" 
Else
 For Each f1 in fc
     PsF = InstrRev(f1,"\")
     FaN = Mid(f1, PF+1)
     if Lcase(fso.GetExtensionName(FaN)) = Lcase(EXN) then
         s = s + 1
         z = "0" & "0" & "0" & s
         q = Len(z) - Len(s)
         zz = Right(z, q)
         f1.Name = URN & "_" & zz & "." & Lcase(EXN)
     end if
 Next
 x=msgbox("リネームプロジェクト完了!!",,"★ 旨くいったかい ?")
End If
End If

'注)　パスに全角文字があったり、変換するファイル名が全角文字の場合や DISKTOP上のファイルを変換する際には、変換にやや時間を要するようでした(-_-;)。

一応、XP-SP3 で動作確認済みですが、エラー対策などしていません。そんな関係で、取り扱いに関しては、責任負いかねますので、自己責任でお願い致します ^_^;

2008-06-01 02:45 nice!(1) コメント(1) トラックバック(0)
共通テーマ：パソコン・インターネット