アナログCPU:5108843109

ゲームと音楽とプログラミング(酒と女とロックンロールのノリで)

('ω') < イザユケエンジニャー

ファイル名を適当にナンバリングする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