ドラッグドロップで更新日時をファイル名に付与するVBScript
2021年03月25日
フォルダ別に作成されたログファイルが全部同じ名前で保存されている。。。
全件をローカルにコピペした場合は、（数字）で持ってこれるけど、
負荷軽減のために複数回に分けようとすると、windowsのバージョンが古いせいか
上書きしますかYES/NOしかない。
ファイル名に更新日時を付与したい衝動にかられる。
バッチファイルで使えそうなやつをみつけたけど、
更新日時の秒が入ってないのでそのままじゃ使えず。
軽くいじってみるも、うまくいかず断念。
自動的にファイル名に更新日付を付けるバッチファイルを作ったら便利すぎた
Engineer's Notebook
https://eng-notebook.com/post-3246/
VBScriptで自作を決意。
でもそのまえにググってみたら、もろHIT!
本部長は管理ができない
http://gren-dken.hatenablog.com/entry/2013/08/22/000119
冒頭部分のエラー処理については、こちらのサイトから
解析エンジニアの自動化 blog
http://chuckischarles.hatenablog.com/entry/2018/10/29/002921
利便性を考えて、更新日時の文字数は冒頭の定数で変更可能にした。
リネーム後のファイル名が既に使われている場合、
自動的に(№)を付与する仕様に変更。
ファイルの頭につけるかお尻につけるか
定数を定義して、IF文で分岐するように修正。
以下、ソース
全件をローカルにコピペした場合は、（数字）で持ってこれるけど、
負荷軽減のために複数回に分けようとすると、windowsのバージョンが古いせいか
上書きしますかYES/NOしかない。
ファイル名に更新日時を付与したい衝動にかられる。
バッチファイルで使えそうなやつをみつけたけど、
更新日時の秒が入ってないのでそのままじゃ使えず。
軽くいじってみるも、うまくいかず断念。
自動的にファイル名に更新日付を付けるバッチファイルを作ったら便利すぎた
Engineer's Notebook
https://eng-notebook.com/post-3246/
VBScriptで自作を決意。
でもそのまえにググってみたら、もろHIT!
本部長は管理ができない
http://gren-dken.hatenablog.com/entry/2013/08/22/000119
冒頭部分のエラー処理については、こちらのサイトから
解析エンジニアの自動化 blog
http://chuckischarles.hatenablog.com/entry/2018/10/29/002921
利便性を考えて、更新日時の文字数は冒頭の定数で変更可能にした。
リネーム後のファイル名が既に使われている場合、
自動的に(№)を付与する仕様に変更。
ファイルの頭につけるかお尻につけるか
定数を定義して、IF文で分岐するように修正。
以下、ソース
Option Explicit
const dateLen = 15 'yyyymmdd_hhmmss の左から何文字取るか 最大１５文字
const LeftFlag = 0 'ファイル名の頭に更新日時をつけるフラグ
'ドラッグドロップでファイルを印刷するスクリプト
'http://chuckischarles.hatenablog.com/entry/2018/10/29/002921
'ファイル名の末尾に更新日時を付与するVBScript
'http://gren-dken.hatenablog.com/entry/2013/08/22/000119
'-------------------------------------------------------------------------------------------------------
' 引数が無かった時の処理
If WScript.Arguments.count = 0 then
WScript.Echo "引数が無いため、実行できません。" & vbNewLine & _
"ファイルをドロップしてください。"
WScript.Quit
End If
'確認
' if msgbox("更新日時でリネームします。よろしいでしょうか？",vbyesno) = vbno then
' WScript.Quit
' end if
dim targetPath,changePath
dim FSO
'----------------------------------------------------------------------------------------------------
' ファイルシステムオブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
'-------------------------------------------------------------------------------------------------------
' フォルダ内ファイルリスト出力
for each targetPath In WScript.Arguments
'----------------------------------------------------------------------------------------------------
' ドロップされた引数がフォルダかファイルかを判定する
If FSO.FolderExists(targetPath) then
' is folder.
WScript.Echo "フォルダがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
ElseIf FSO.FileExists(targetPath) then
' is file.
else
' is unknown.
WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
End If
'----------------------------------------------------------------------------------------------------
changePath = createNewFilePath(targetPath , dateLen)
' リネーム
Call FSO.MoveFile(targetPath, changePath)
Next
set FSO = nothing
'------------------------------
' 更新日付を付与したパスを生成
'------------------------------
Function createNewFilePath(targetPath , dateLen)
Dim fo
Set fo = fso.GetFile(targetPath)
' ファイル更新日時取得 + 不要文字削除
Dim lastModified
lastModified = fo.DateLastModified
lastModified = Replace(lastModified, "/", "")
lastModified = Replace(lastModified, ":", "")
lastModified = Replace(lastModified, " ", "_")
lastModified = left(lastModified, dateLen)
' ファイルパス分割
Dim targetDir
Dim targetBaseName
Dim targetExt
targetDir = fso.GetParentFolderName(targetPath)
targetBaseName = fso.GetBaseName(targetPath)
targetExt = fso.GetExtensionName(targetPath)
dim tmpName ,cnt
cnt = 2
' 変更後ファイルパス生成し、返却
if LeftFlag > 0 then
tmpName = targetDir & "\" & lastModified & "_" & targetBaseName & "." & targetExt
if fso.FileExists(tmpName) then
tmpName = targetDir & "\" & lastModified & "-" & cnt & "_" & targetBaseName & "." & targetExt
do while fso.FileExists(tmpName)
cnt = cnt + 1
tmpName = targetDir & "\" & lastModified & "-" & cnt & "_" & targetBaseName & "." & targetExt
loop
end if
else
tmpName = targetDir & "\" & targetBaseName & "_" & lastModified & "." & targetExt
if fso.FileExists(tmpName) then
tmpName = targetDir & "\" & targetBaseName & " (" & cnt & ")_" & lastModified & "." & targetExt
do while fso.FileExists(tmpName)
cnt = cnt + 1
tmpName = targetDir & "\" & targetBaseName & " (" & cnt & ")_" & lastModified & "." & targetExt
loop
end if
end if
createNewFilePath = tmpName
End Function
const dateLen = 15 'yyyymmdd_hhmmss の左から何文字取るか 最大１５文字
const LeftFlag = 0 'ファイル名の頭に更新日時をつけるフラグ
'ドラッグドロップでファイルを印刷するスクリプト
'http://chuckischarles.hatenablog.com/entry/2018/10/29/002921
'ファイル名の末尾に更新日時を付与するVBScript
'http://gren-dken.hatenablog.com/entry/2013/08/22/000119
'-------------------------------------------------------------------------------------------------------
' 引数が無かった時の処理
If WScript.Arguments.count = 0 then
WScript.Echo "引数が無いため、実行できません。" & vbNewLine & _
"ファイルをドロップしてください。"
WScript.Quit
End If
'確認
' if msgbox("更新日時でリネームします。よろしいでしょうか？",vbyesno) = vbno then
' WScript.Quit
' end if
dim targetPath,changePath
dim FSO
'----------------------------------------------------------------------------------------------------
' ファイルシステムオブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
'-------------------------------------------------------------------------------------------------------
' フォルダ内ファイルリスト出力
for each targetPath In WScript.Arguments
'----------------------------------------------------------------------------------------------------
' ドロップされた引数がフォルダかファイルかを判定する
If FSO.FolderExists(targetPath) then
' is folder.
WScript.Echo "フォルダがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
ElseIf FSO.FileExists(targetPath) then
' is file.
else
' is unknown.
WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
End If
'----------------------------------------------------------------------------------------------------
changePath = createNewFilePath(targetPath , dateLen)
' リネーム
Call FSO.MoveFile(targetPath, changePath)
Next
set FSO = nothing
'------------------------------
' 更新日付を付与したパスを生成
'------------------------------
Function createNewFilePath(targetPath , dateLen)
Dim fo
Set fo = fso.GetFile(targetPath)
' ファイル更新日時取得 + 不要文字削除
Dim lastModified
lastModified = fo.DateLastModified
lastModified = Replace(lastModified, "/", "")
lastModified = Replace(lastModified, ":", "")
lastModified = Replace(lastModified, " ", "_")
lastModified = left(lastModified, dateLen)
' ファイルパス分割
Dim targetDir
Dim targetBaseName
Dim targetExt
targetDir = fso.GetParentFolderName(targetPath)
targetBaseName = fso.GetBaseName(targetPath)
targetExt = fso.GetExtensionName(targetPath)
dim tmpName ,cnt
cnt = 2
' 変更後ファイルパス生成し、返却
if LeftFlag > 0 then
tmpName = targetDir & "\" & lastModified & "_" & targetBaseName & "." & targetExt
if fso.FileExists(tmpName) then
tmpName = targetDir & "\" & lastModified & "-" & cnt & "_" & targetBaseName & "." & targetExt
do while fso.FileExists(tmpName)
cnt = cnt + 1
tmpName = targetDir & "\" & lastModified & "-" & cnt & "_" & targetBaseName & "." & targetExt
loop
end if
else
tmpName = targetDir & "\" & targetBaseName & "_" & lastModified & "." & targetExt
if fso.FileExists(tmpName) then
tmpName = targetDir & "\" & targetBaseName & " (" & cnt & ")_" & lastModified & "." & targetExt
do while fso.FileExists(tmpName)
cnt = cnt + 1
tmpName = targetDir & "\" & targetBaseName & " (" & cnt & ")_" & lastModified & "." & targetExt
loop
end if
end if
createNewFilePath = tmpName
End Function
PR
Comment