【vbs】フォルダ/ファイル名にYYMMDDを追加する(ドラッグアンドドロップor右クリックから)
フォルダやファイルの作成時に接頭か語尾に作成した日付を入れる
みたいな命名ルールがあったりしませんか?
自分の会社にはあります。めんど。
例えば、
231004_新しいドキュメント
もしくは
新しいフォルダ_231004
みたいな。
先輩に相談されたので自動化してみました。よくあるやつですが。
ソースコード
以下、ソースコードです。メモ帳にコピペして、拡張子をvbsで保存します。
' ドラッグアンドドロップされたデータを格納する変数
Dim args
Set args = WScript.Arguments
'ファイルシステムを扱うオブジェクトを作成
Dim objFileSys
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'現在時間
datetimeNow = Now()
'年
now_YYYYMMDDhhmmss= Year(datetimeNow)
'月
now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Month(datetimeNow) , 2)
'日付
now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Day(datetimeNow) , 2)
'時間
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Hour(datetimeNow) , 2)
'それ以下の時間(いらないかも)
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Minute(datetimeNow) , 2)
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Second(datetimeNow) , 2)
' イテレーター
Dim iterator
'元のファイル名
Dim orgName
'拡張子
Dim exName
'新しいフォルダ/ファイル名
Dim newName
For Each iterator In args
'フォルダの場合
If objFileSys.FolderExists(iterator) Then
orgName = objFileSys.GetFileName(iterator)
'接頭の場合
newName = now_YYYYMMDDhhmmss & "_" & orgName
'語尾の場合
'newName = orgName & "_" & now_YYYYMMDDhhmmss
' フォルダオブジェクト
Set objFolder = objFileSys.GetFolder(iterator)
' ファイル名の変更
objFolder.Name = newName
'ファイルの場合
else
orgName =objFileSys.GetBaseName(iterator)
exName = objFileSys.Getextensionname(iterator)
'接頭の場合
newName = now_YYYYMMDDhhmmss & "_" & orgName & "." & exName
'語尾の場合
'newName = orgName & "_" & now_YYYYMMDDhhmmss & "."&exName
' ファイルオブジェクト
Set objFile = objFileSys.GetFile(iterator)
' ファイル名の変更
objFile.Name = newName
end if
Next
Set objFileSys = Nothing
Set args = Nothing
と、言われたので、
'年
now_YYYYMMDDhhmmss= Year(datetimeNow)
'月
now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Month(datetimeNow) , 2)
'日付
now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Day(datetimeNow) , 2)
'時間
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Hour(datetimeNow) , 2)
'それ以下の時間(いらないかも)
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Minute(datetimeNow) , 2)
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Second(datetimeNow) , 2)
↑の部分で変えれるようにしてます。年がいらないならコメントアウトします。
'年 ↓コメントアウト
'now_YYYYMMDDhhmmss= Year(datetimeNow)
'月
now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Month(datetimeNow) , 2)
'日付
now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Day(datetimeNow) , 2)
'時間
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Hour(datetimeNow) , 2)
'それ以下の時間(いらないかも)
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Minute(datetimeNow) , 2)
'now_YYYYMMDDhhmmss= now_YYYYMMDDhhmmss & Right("0" & Second(datetimeNow) , 2)
サンプル画像はテキストファイルだけですが、パワポや動画、画像なんかもごちゃまぜでもうごきます。
MMDDかYYMMDDかの切り替えの自動化も考えましたがやめました。めんどくさい。多分文字数で切り替えても、「このファイルは違うんだよな〜」って言いだすはず。
ここはvbsを2ファイル用意して使い分けてもらう方が良さそうです。
ファイルを右クリックでリネームできるようにする。
しばくぞ。
まぁ確かに自分もデスクトップ散らかすのはきらいで嫌いです。今回は右クリックでリネーム出来るようにするため、「ファイルを選択」→「右クリック」→「送る」の機能を使います。
Win+Rで、「Shell:sendto」って検索します
さっき作ったVBSのショートカット入れます。
(その前に、どこでもいいんで、適当なフォルダに収納しといて下さい)
ショートカットなんで、アイコンも変えれます。
もちろんそのままでもいいです。
完成ですね。もう文句ないでしょう。
ありがとうございました。
──そういえば二回以上リネームしたらどうなるんだろう。。。。
あ。。。
止まらない。。。
ファイル名は死にました。
今のところ文句ないので出たら考えます。
有難うございました。
※先輩とは仲良いです
この記事が気に入ったらサポートをしてみませんか?