【VBScript】選択したファイルをbakフォルダへ最終更新日時を付加してコピー(バックアップ)する

ファイルと同じ階層にbakフォルダを作成し、最終更新日時をファイル名に付加してコピー(バックアップ)する

使用方法:本ソースファイルを「.vbs」にて保存。バックアップしたいファイルを本スクリプトへドラッグ&ドロップすると自動的に開始される。
筆者は、SendToメニューに追加し、[送る]メニューから利用している。

Option Explicit

' 直接実行しても動作しない
If Wscript.Arguments.Count = 0 Then Wscript.Quit

' FileSystemObject
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

' カレントフォルダとバックアップアップフォルダを指定
Dim CurFolder: CurFolder = objFSO.GetParentFolderName(WScript.Arguments(0))
Dim BakFolder: BakFolder = CurFolder & "\bak\"

' その他変数定義
Dim tmpArg	' ループ変数(ファイル名)
Dim tmpBaseName	' ループ内変数(拡張子を除くファイル名)
Dim tmpExtName	' ループ内変数(拡張子のみ)
Dim tmpDLMName	' ループ内変数(ファイルの最終更新日時)
Dim tmpFile	' ループ内変数(バックアップファイル)
Dim strNewName	' ループ内変数(バックアップするファイル名)

' バックアップフォルダを作成
If Not objFSO.FolderExists(BakFolder) Then objFSO.CreateFolder(BakFolder)

' ドラッグアンドドロップされたファイルをひとつずつバックアップフォルダへ最終更新日時をつけてコピーする
For Each tmpArg In WScript.Arguments
	' 拡張子を除くファイル名を取得
	tmpBaseName = objFSO.GetBaseName(tmpArg)

	' 拡張子のみを取得
	tmpExtName = objFSO.GetExtensionName(tmpArg)

	' ファイルの最終更新日時を取得し、yyyymmddhhmmss形式へ変換する
	tmpDLMName = objFSO.GetFile(tmpArg).DateLastModified
	tmpDLMName = ZeroPaddingDateTime(tmpDLMName)

	' バックアップファイル名を組み立てる
	strNewName = tmpBaseName & "_" & tmpDLMName & "." & tmpExtName

	' 同名のファイルが存在しない場合、バックアップフォルダへコピーする
	If Not objFSO.FileExists(BakFolder & strNewName) Then
		objFSO.CopyFile tmpArg, BakFolder & strNewName
	Else
		MsgBox "ファイルが存在しています。", vbOKOnly + vbCritical, WScript.ScriptName
	End If

	' バックアップファイルに読み取り専用属性を付加
	Set tmpFile = objFSO.GetFile(BakFolder & strNewName)
	If tmpFile.Attributes And 1 Then
		' 読み取り専用なら何もしない
	Else
		tmpFile.Attributes = tmpFile.Attributes + 1
	End If
	Set tmpFile = Nothing

Next

Set objFSO = Nothing

' 完了メッセージを表示
'MsgBox "バックアップをbakフォルダにコピーしました。", vbOKOnly + vbInformation, WScript.ScriptName
' または、完了ポップアップを表示(5秒後に消える)
CreateObject("WScript.Shell").Popup "バックアップをbakフォルダにコピーしました。", 5, WScript.ScriptName, vbOKOnly + vbInformation


' 最終更新日時をyyyymmddhhmmss形式へ変換する関数
Function ZeroPaddingDateTime(ByVal tmpDLMName)
	Dim newTemp: newTemp = ""
	newTemp = newTemp & Right("0000" & Year(tmpDLMName), 4)
	newTemp = newTemp & Right("00" & Month(tmpDLMName), 2)
	newTemp = newTemp & Right("00" & Day(tmpDLMName), 2)
	newTemp = newTemp & Right("00" & Hour(tmpDLMName), 2)
	newTemp = newTemp & Right("00" & Minute(tmpDLMName), 2)
	newTemp = newTemp & Right("00" & Second(tmpDLMName), 2)
	ZeroPaddingDateTime = newTemp
End Function
  • (2019.01.18) アーカイブファイルに読み取り専用属性を付加するよう機能追加