トップ > VBA > VBSとタスクスケジューラでデスクトップのバックアップを取る

VBSとタスクスケジューラでデスクトップのバックアップを取る

VBA

【スポンサーリンク】


ついついデスクトップに色々置いて作業してしまうのですが、この前パソコンが起動しなくてヒヤッとしたので、VBSとタスクスケジューラを使ってバックアップを取ることにしました。
ただサーバーにコピーするだけの簡単なものです。


どんなもの？

・バックアップ先にフォルダを作成し、デスクトップに置いてあるものを全てそこにコピーして入れる
・古いバックアップは自動的に削除する

前提

・タスクスケジューラで2桁時間（10〜23時）に実行させる（その方がフォルダ名の処理をしやすいため）

手順

①バックアップ先のフォルダを作成する
②以下のコードをメモ帳に貼り付け、拡張子を.vbs、文字コードを「UTF-16 LE」にして保存
VBSの保存先はどこでも。わかりやすくバックアップ先でもOK。

On Error Resume Next
Dim WS, FSO, CopyPath, PastePath, PasteName, bkCnt, tskCnt

Set WS = CreateObject("WScript.Shell")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

CopyPath = WS.SpecialFolders("Desktop") 'バックアップを取る場所のフルパス
PastePath = "サーバーのパス\バックアップ先\" '貼り付け先のフルパス
bkCnt = 3 'バックアップを残す日数(○日分)
tskCnt = 3 '1日にバックアップを取る回数

'「yyyy/mm/dd hh:mm:ss」を「yyyymmddhh」に変換したものをフォルダ名にし，ファイルをコピーして入れる
PasteName = Replace(Replace(Left(Now(), 13), "/", ""), " ", "")
FSO.CreateFolder PastePath & PasteName
FSO.GetFolder(CopyPath).Copy PastePath & PasteName

'バックアップの個数が日数×回数を超えたら削除処理
If FSO.GetFolder(PastePath).SubFolders.Count >= bkCnt * tskCnt + 1 Then
    Dim NowD, DelD

    Do Until FSO.GetFolder(PastePath).SubFolders.Count = bkCnt * tskCnt
        For Each Fol In FSO.GetFolder(PastePath).SubFolders
            If NowD = "" Then NowD = Fol.Name '比較側
            If DelD = "" Then DelD = Fol.Name '削除側

            '日付が古いものを削除側に入れる
            If NowD < DelD Then DelD = NowD

            NowD = Fol.Name
        Next

        FSO.DeleteFolder DelD
        DelD = ""
    Loop
End If

WS.Popup "バックアップ完了", 5, "完了" '5秒後に自動的に閉じる


③タスクスケジューラでVBSを実行するタスクの作成をする
2桁時間（10〜23時）＆tskCntに指定した回数動作するように条件を設定。

【スポンサーリンク】