日付フォルダ作成VBScriptに日付オフセット機能を追加した話
2024年12月31日
過去に投稿した記事で、日付のフォルダを作るというものがある。
日付のフォルダを作るVBscript 趣味プログラミングblog (p-kin.net)
日付のフォルダを作るVBscript2 趣味プログラミングblog (p-kin.net)
リリース関係の作業だったら当日のフォルダだけ作れれば良いけど、前もって作ろうとか思うと翌日のフォルダとかを作りたくなる。
今回は、指定した日付だけずらした日のフォルダを作成するスクリプトについての話。
日付のフォルダを作るVBscript 趣味プログラミングblog (p-kin.net)
日付のフォルダを作るVBscript2 趣味プログラミングblog (p-kin.net)
リリース関係の作業だったら当日のフォルダだけ作れれば良いけど、前もって作ろうとか思うと翌日のフォルダとかを作りたくなる。
今回は、指定した日付だけずらした日のフォルダを作成するスクリプトについての話。
仕様
- スクリプトを実行するとインプットボックスが出る
- エンターを押すと、今日の日付のフォルダができる
- テキストを入力すると、日付_テキストのフォルダができる
- +1テキストを入力すると、明日の日付_テキストよフォルダができる【機能追加】
UIの設計
元々の仕様が、インプットボックスでテキストの入力を求めて「日付8桁_テキスト」のフォルダを作成するもの。テキストがなければ日付8桁フォルダを作成する。個人的なUIのこだわりで、確認メッセージなどに対する操作は1回だけにしたい。たまにしか使わない機能のために別のインプットボックスを出すのはやりたくない。
ということで、インプットボックスの入力内容が-9から+9で始まる場合にその数字だけずらした日付のフォルダを作成する仕様にした。
キャンセル機能の搭載
インプットボックスでキャンセルした場合にキャンセルできるよう機能追加。元々は、インプットボックスに何も入力せずにエンターを押した場合と、キャンセルボタンを押した場合と挙動が同じになっていた。（どっちも入力値がブランクなので）
インプットボックスのデフォルトをブランクから変更して、
ブランクなら終了、デフォルトならOK操作と判定。
この辺りの仕様は別の記事で書いたな。
VBScriptのInputBoxでキャンセル判定する方法について 趣味プログラミングblog (p-kin.net)
アルゴリズム
１文字目が、+か-で始まって、２文字目が数値ならばオフセット処理を行って、入力テキストから左側2文字を削除する。
それ以外の場合は今まで通り。
全角入力への対応
エラー処理を考えると、-9から+9を全角で打ってくる可能性が考えられる。その場合でも半角に直して処理してやりたい。と思ったけど、インプットボックスが表示されたとき半角入力がデフォルトっぽいからやる意味ないかも。。。
気が向いたら記事にしよう。
以下、ソースコードファイルとテキスト。
<a href="https://blog.cnobi.jp/v1/blog/user/60a2f5771661576d9560c4bc53c032f8/1735733571" target="_blank">txtファイルで表示</a>
' main
call MakeDateDir
'-----------------------------------------------------------
sub MakeDateDir()
'文字列を取得
dim iText : iText = inputbox("作成するフォルダの内容は？", , " ")
' 入力がブランクの場合はスクリプトを終了
if iText = "" then exit sub
' 日付とオフセットを取得
dim currentDate, strDate, DirName, offset
currentDate = now
if iText <> " " then
' オフセットを取得
if (left(iText, 1) = "+" or left(iText, 1) = "-") and isnumeric(mid(iText, 2, 1)) then
offset = cint(mid(iText, 2, 1))
if left(iText, 1) = "-" then
offset = -offset
end if
iText = mid(iText, 3) ' オフセット部分を取り除く
currentDate = DateAdd("d", offset, currentDate)
end if
end if
strDate = left(Replace(currentDate, "/", ""), 8)
' フォルダ名の決定
if trim(iText) = "" then
DirName = strDate
else
DirName = strDate & "_" & iText
end if
' ファイルストリーム・オブジェクト生成
with CreateObject("Scripting.FileSystemObject")
If .FolderExists(DirName) Then
'msgbox "すでにフォルダが存在します"
else ' フォルダを生成する
str_path = .CreateFolder(DirName)
end if
end with
call OpenTheFolder(DirName)
end Sub
' フォルダを開く
sub OpenTheFolder(DirPath)
CreateObject("Shell.Application").ShellExecute DirPath
end sub
PR
Comment