共同で使うエクセルはある日いきなり何者かに破壊される運命にあります。そんな時の為に自動で定期的にバックアップ保存＆破壊したユーザを特定するためのマクロ
備えあれば憂いなし
Excelを共有フォルダに置き、複数人で利用する様な環境にある場合いつか必ずその時はやってきます。
特に弊社は駆け出しVBAerにスキルアップの為保守をやって貰ってるので、
いつやらかしてしまっても大丈夫なように自動でバックアップを帆依存するマクロを追加してみた。
Workbook_BeforeSaveで変更直前にBookのコピーを取る
バックアップを取るなら保存するその直前に保存するのがベスト。
Workbook_BeforeSaveは名前の通り保存が完了する前に呼び出されるので、ここに以下のコードを記載する↓
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim strPass As String Dim WSH As Variant Dim fso As New Scripting.FileSystemObject ' Microsoft Scripting Runtimeの参照設定必須 ' マイドキュメントパス+今日の年月日 Set WSH = CreateObject("WScript.Shell") strPass = WSH.SpecialFolders("MyDocuments") & "\" & Format(Date, "yyyymmdd") ' 今日の年月日フォルダの存在チェック If Dir(strPass, vbDirectory) = "" Then ' 存在しなければ作成する MkDir strPass End If ' 年月日フォルダにエクセルをコピーして保存。ファイル名は時分秒.xlsm fso.CopyFile ThisWorkbook.FullName, strPass & "\" & Format(Now, "hhmmss") & "." & fso.GetExtensionName(ThisWorkbook.FullName) End Sub |
こうしておく事で、このエクセルが上書き保存される度、その直前にバックアップが自動で取られるようになる↓
これはテスト用なのでローカルに保存してますが、共有フォルダ等のパスに変更して使用しましょう。
ユーザー特定機能を盛り込む
上記に加え、再発防止の意味でもどのユーザが破壊したのかも知っておきたいので、
実行したユーザのMACアドレスか、固定で振っているならIPアドレスのどちらかを追加したい。
これらの情報は以下の様に取得出来る↓
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Sub GetAddress() Dim objWMI As Object Dim objAdapter As Object Dim strIP As Variant Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration Where (IPEnabled = TRUE)") For Each objAdapter In objWMI For Each strIP In objAdapter.IPAddress Debug.Print "IP:" & strIP & " MAC:" & objAdapter.MACAddress Exit For Next Next End Sub |
実行結果↓
後は組み合わせてファイル名にそのまま追記するも良し、アドレス毎にフォルダ分けするも良しお好みに合わせて。
ちなみにコロンはファイル名に出来ないのでMACアドレスを使用する場合はReplace(strMAC, “:”, “”)で取り除きましょう。
タイマー張って定期的にバックアップとって強制終了に備えるってのも面白いかもね(ᵔᴥᵔ)
コメント