ファイル名を適当にナンバリングするVBS
Windowsにて、ひとつのフォルダの中にあるファイル名を「001.***」「002.***」「003.***」…という感じで自動でナンバリングしたくて9年ほど前に作ったやつ。
その後ずっと使ってて謎の愛着のあるVBSなんですが、最近ファイル管理の命名規則変えて使わなくなったのでお蔵入りする代わりに貼っておく。
準備
- 対象フォルダに「name.ini」というテキストファイルを用意
- 中身は「001」とだけ入力
- VBSファイル(コードは後述)はデスクトップでもなんでも好きなところに置いておく
使い方
- ナンバリングしたいファイルを対象フォルダに入れる
- ナンバリングしたい順に、VBSファイルの上にドラッグ&ドロップする
VBSのコード
無駄に長い。
Option Explicit ' ***** 変数設定 ***** Dim strFileName ' 旧ファイル名 Dim strFileNum ' 新ファイル名になる通し番号を格納 Dim intErrNum ' エラー判定用 Dim strIniFile Dim intNumSize ' ***** ユーザ設定 ***** strIniFile = "name.ini" ' iniファイルの名前 intNumSize = 3 ' ファイルナンバーの桁数 ' ***** 引数がない場合 ***** If WScript.Arguments.Count = 0 Then WScript.Echo "ファイルを指定してください。" ' ***** 引数が複数の場合 ***** ElseIf WScript.Arguments.Count > 1 Then WScript.Echo "ファイルは1つだけ指定してください。" ' ***** 引数が1つの場合(正常) ***** ElseIf WScript.Arguments.Count = 1 Then ' **** カレントディレクトリを移動 **** CurrentDirectory(WScript.Arguments.Item(0)) ' **** ファイル名取得 **** strFileName = Mid(WScript.Arguments.Item(0), InStrRev(WScript.Arguments.Item(0), "\") + 1) ' **** iniファイルから番号を読み出す **** strFileNum = IniFileNum ' **** ファイル名変更 **** intErrNum = ChangeName (strFileName, strFileNum) ' **** iniファイル書き換え **** If intErrNum = 0 Then intErrNum = IniIncNum(strFileNum) End If ' ***** ありえないはずなんだが ***** Else WScript.Echo "エラー" End If '========== カレントディレクトリを移動 ========== ' 名前:CurrentDirectory ' 引数:FilePath(操作ファイルのフルパス) '================================================ Sub CurrentDirectory (strFilePath) ' *** 変数設定 *** Dim objWshShell ' カレントディレクトリ移動用 Dim strCDPath ' ディレクトリのパスを格納 Set objWshShell = WScript.CreateObject("WScript.Shell") ' *** ディレクトリ取得 *** strCDPath = Left(strFilePath, InStrRev(strFilePath, "\") - 1) ' *** ディレクトリ移動 *** objWshShell.CurrentDirectory = strCDPath Set objWshShell = Nothing End Sub '========== ファイルの通し番号を読み出す ========== ' 名前:IniFileNum ' 戻り値:IniFileNum(通し番号) '================================================== Function IniFileNum ' *** 変数設定 *** Dim objFSO ' FileSystemObject Dim objFile ' ファイル書き込み用 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(strIniFile) ' *** 通し番号を求める:エラーのときはとりあえず000を返す *** If Err.Number = 0 Then IniFileNum = objFile.ReadLine Else WScript.Echo "エラー: " & Err.Description IniFileNum = "000" End If Set objFSO = Nothing Set objFile = Nothing End Function '========== ファイル名を変更する ========== ' 名前:ChangeName ' 引数:strBFile(旧ファイル名) ' strNNum(新ファイル名(拡張子を除く、番号部分のみ)) ' 戻り値:ChangeName(成功かどうか:0ならOK、それ以外ならNG) '========================================== Function ChangeName (strBFile, strNNum) ' *** 変数設定 *** Dim objFSO ' FileSystemObject Dim strNFile ' 新ファイル名 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") ' *** 新ファイル名生成 *** strNFile = strNNum & Mid(strBFile, InStrRev(strBFile, ".")) ' *** ファイル名変更 *** objFSO.MoveFile strBFile, strNFile ' *** エラー番号を返す *** ChangeName = Err.Number Set objFSO = Nothing End Function '========== iniファイルの数字をインクリメントする ========== ' 名前:IniIncNum ' 引数:strBeforeNum(旧番号) ' 戻り値:IniIncNum(成功かどうか:0ならOK、それ以外ならNG) '================================================== Function IniIncNum (strBeforeNum) ' *** 変数設定 *** Dim objFSO ' FileSystemObject Dim objFile ' ファイル書き込み用 Dim intNewNum ' インクリメントした番号 Dim strNewIniNum ' 新しく書き込む番号 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(strIniFile, 2, True) ' *** 番号のインクリメント *** intNewNum = strBeforeNum + 1 ' *** 文字として扱い、桁数をそろえる(3桁:インクリメント結果が12なら"012"へ) *** strNewIniNum = CStr(intNewNum) Do While intNumSize - Len(strNewIniNum) > 0 strNewIniNum = "0" & strNewIniNum Loop ' *** 書き込む *** objFile.Write (strNewIniNum) objFile.Close ' *** エラー番号を返す *** IniIncNum = Err.Number Set objFSO = Nothing Set objFile = Nothing End Function