指定フォルダに日付付きでバックアップ

zipファイルなどを指定のフォルダに「YYMMDD/元ファイル名_YYMMDD_HHMMSS」でコピーするVBScriptです。

コンテキストメニューの「送る」にショートカットを置いて使用します。

'指定フォルダに日付付きでバックアップ

Const path = "C:\バックアップ\"

' 引数のチェック
Set args = WScript.Arguments

If args.Count = 0 Then
    Msgbox "ファイルをvbsファイルにドラッグアンドドロップしてください。", vbInformation, "情報"
    WScript.Quit
End If

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(args(0))

' 読み取り専用を解除
If file.Attributes And 1 Then
    file.Attributes = file.Attributes And &HFE
End If

' ファイル名チェック
nameAry = Split(file.Name,".")
If (Ubound(nameAry) <> 1) Then
    Msgbox "ファイル名が不適切です。", vbExclamation, "警告"
    WScript.Quit
End If

' ファイル名変更
strDate = Replace(FormatDateTime(now, vbShortDate), "/", "")
strTime = Replace(FormatDateTime(now, vbShortTime), ":", "")
file.Name = nameAry(0) & "_" & strDate & "_" & strTime & "." & nameAry(1)

' フォルダ名決定
folder = path & Replace(strDate, "/", "")

' 日付フォルダ存在チェック
If (fso.FolderExists(folder)) Then
    ' 日付フォルダあり
Else
    ' 日付フォルダがないため作成
    fso.CreateFolder(folder)
End IF

' ファイルコピー
fso.CopyFile file.path, folder & "\", True

' 元ファイル削除(直接)
'fso.DeleteFile file.path, True

' 元ファイルをゴミ箱へ送る
Const ssfBITBUCKET = 10
Set obj = CreateObject("Shell.Application")
Set namesp = obj.Namespace(ssfBITBUCKET)
namesp.movehere file.path

' フォルダを開く
obj.ShellExecute path

Msgbox folder & "\" & " へのバックアップが完了しました。", vbInformation, "情報"

' 終了
WScript.Quit