ファイル名の頭に日付を加える

概要

ファイルをドラッグ＆ドロップするとファイル名の頭に日付を加えるスクリプト。

test.txt -> 211113-1_test.txt

ファイル名の頭に日付を加える

Const APP_NAME = "ファイル名変更"

Dim args     '引数のコレクション
Dim filePath 'ドラッグ＆ドロップしたファイルのパス
Dim fso      'ファイルシステムオブジェクト
Dim file     'ファイルオブジェクト
Dim head     '日付を表す6桁の数値

Set args = WScript.Arguments

'引数が1個でなければ終了
If args.Count <> 1 Then
    Msgbox "1ファイルをドラッグ＆ドロップして下さい。",,APP_NAME
    WScript.Quit()
End If

filePath = args.Item(0)
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(filePath) Then
'ドラッグ＆ドロップしたのがファイルであればファイルオブジェクトを取得
    Set file = fso.GetFile(filePath)
Else
'ドラッグ＆ドロップしたのがフォルダであれば終了
    Msgbox "ファイルをドラッグ＆ドロップして下さい。",,APP_NAME
    WScript.Quit()
End If

'ファイル名を変更
head = Get6Date()
Call Rename(file, head, 1) '3番目の引数は名前の重複を避けるための枝番

'終了処理
Set fso  = Nothing
Set file = Nothing


Function Get6Date()
'6桁の日付を返す
    Dim before

    before = Inputbox("何日前の日付にしますか", APP_NAME, 0)

    '数字でない場合やキャンセルボタンが押された場合は終了
    If before = "" Then WScript.Quit()
    If Not IsNumeric(before) Then WScript.Quit()

    before = CLng(before) '数字として扱う
    Get6Date = Right(Replace(Date() - before, "/", ""), 6)
End Function


Function Rename(f, head, branch)
'ファイル名変更
    Dim buf, newPath
    buf = f.Path & "\..\" & head & "-" & branch & "_" & f.Name
    newPath = fso.GetAbsolutePathName(buf)
    
    If fso.FileExists(newPath) Then
    '変更後と同名のファイルがあれば枝番を1増やして再起呼び出し
        Call Rename(f, head, branch + 1)
    Else
    '変更後と同名のファイルが無ければ名前を変更する
        f.Move(newPath) '変更
    End If
End Function