趣味プログラミングblog

---

Option Explicit
const dateLen = 8 'yyyymmdd_hhmmss の左から何文字取るか　最大１５文字　
const LeftFlag = 1 'ファイル名の頭に更新日時をつけるフラグ

'-------------------------------------------------------------------------------------------------------
' 引数が無かった時の処理
If WScript.Arguments.count = 0 then
WScript.Echo "引数が無いため、実行できません。" & vbNewLine & _
"ファイルをドロップしてください。"
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.
'----------------------------------------------------------------------------------------------------
changePath = createNewFolderPath(targetPath , dateLen)
' リネーム
Call FSO.MoveFolder(targetPath, changePath)

ElseIf FSO.FileExists(targetPath) then
' is file.
'----------------------------------------------------------------------------------------------------
changePath = createNewFilePath(targetPath , dateLen)
' リネーム
Call FSO.MoveFile(targetPath, changePath)

else
' is unknown.
WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
End If
Next

set FSO = nothing

'------------------------------
' 更新日付を付与したパスを生成
'------------------------------
Function date2str(txt,dateLen)
txt = Replace(txt, "/", "")
txt = Replace(txt, ":", "")
txt = Replace(txt, " ", "_")
txt = left(txt, dateLen)
date2str = txt
end Function

Function createNewFilePath(targetPath , dateLen)
Dim fo
Set fo = fso.GetFile(targetPath)

' ファイル更新日時取得 + 不要文字削除
Dim lastModified
lastModified = date2str(fo.DateLastModified,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


Function createNewFolderPath(targetPath , dateLen)
Dim fo
Set fo = fso.GetFolder(targetPath)

' ファイル更新日時取得 + 不要文字削除
Dim lastModified
lastModified = date2str(fo.DateLastModified,dateLen)

' ファイルパス分割
Dim targetDir
Dim targetBaseName
targetDir = fso.GetParentFolderName(targetPath)
targetBaseName = fso.GetBaseName(targetPath)

dim tmpName ,cnt
cnt = 2
' 変更後ファイルパス生成し、返却
if LeftFlag > 0 then
tmpName = targetDir & "\" & lastModified & "_" & targetBaseName
if fso.FolderExists(tmpName) then
tmpName = targetDir & "\" & lastModified & "-" & cnt & "_" & targetBaseName
do while fso.FolderExists(tmpName)
cnt = cnt + 1
tmpName = targetDir & "\" & lastModified & "-" & cnt & "_" & targetBaseName
loop
end if
else
tmpName = targetDir & "\" & targetBaseName & "_" & lastModified
if fso.FolderExists(tmpName) then
tmpName = targetDir & "\" & targetBaseName & " (" & cnt & ")_" & lastModified
do while fso.FolderExists(tmpName)
cnt = cnt + 1
tmpName = targetDir & "\" & targetBaseName & " (" & cnt & ")_" & lastModified
loop
end if
end if
createNewFolderPath = tmpName

End Function