| Home | What's New |
生産性向上 基本テクニック |
トラブル回避 テクニック |
生産性向上 リンク |
personal.xls 強化講座 |
生産性向上 ツール |
Site Map |
Coffee Break |
Guest Book |
地球風 画像館 |
Q&A
Salon EXCELの質問はこちらへ |
| ５．自動保存と同時にバックアップを行う機能の追加 |
06/24/2002 -
|
|
自動保存の設定を行う方法はトラブル回避テクニックの「とにかくセーブ！」で紹介しました。 そこで、 |
|
以下のマクロを personal.xls に追加します。（既に auto_open
が組み込まれている場合は、Auto_Backup_Start の一文だけそこに追加してください。下のマクロ記述の赤字の部分です）
なお、下のマクロではファイルのコピーを行うために Win32API を使用していますので、ちょっと見慣れない命令も使っています。（大村あつし著「VBAユーザーのためのWin32APIプログラミングガイド」エーアイ出版 を参考にしています） |
|
| Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassNams As String, _
ByVal lpWindowName As String) As Long
Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
hwnd As Long 'ダイアログボックスの親ウィンドウのハンドル
wFunc As Long '操作内容を指定する
pFrom As String '操作元のファイル名、ディレクトリ名
pTo As String '操作先のファイル名、ディレクトリ名
fFlags As Integer '操作内容を指定する
fAnyOperationsAborted As Long '処理終了前にキャンセルしたときは「1」
hNameMappings As Long 'ファイルネームマッピングオブジェクト
lpszProgressTitle As String 'ダイアログボックスのキャプション
End Type
Public BackupInterval As Date '自動保存の処理間隔 20020620
Sub auto_open() Auto_Backup_Start
'auto_open に既に他のマクロが記述されている場合には、'この１行だけを追加する End Sub
Sub BackUpFileNameSet() 'プロパティのコメント欄にバックアップ先を指定
'
Dim BackupFileName As Variant
BackupFileName = Application.GetSaveAsFilename _
(FileFilter:="Microsoft Excel ファイル(*.xl*),*.xl*", _
Title:="バックアップ先ファイルの指定")
If BackupFileName <> False Then
If Right(BackupFileName, 4) = ".xl*" Then
BackupFileName = Left(BackupFileName, Len(BackupFileName) - 4)
End If
MsgBox "バックアップ先に " & Chr$(13) & Chr$(13) & _
BackupFileName & Chr$(13) & Chr$(13) & "を指定します。"
BackupFileName = "[Backup] " & BackupFileName
ActiveWorkbook.BuiltinDocumentProperties(5).Value = BackupFileName
End If
'
End Sub
Sub AutoBackup() '保存と同時に別の場所にバックアップする
'
Dim wb As Variant
Dim udtSHFILEOPSTRUCT As SHFILEOPSTRUCT
Dim rc As Long
Dim strClassName As String 'クラス名
Dim FO_COPY As Variant 'コピー
Dim FOF_NOCONFIRMATION As Variant '確認なし
FO_COPY = &H2&
FOF_NOCONFIRMATION = &H10&
strClassName = "XLMAIN"
For Each wb In Workbooks
If wb.BuiltinDocumentProperties(5).Value <> "" And _
Left(wb.BuiltinDocumentProperties(5).Value, 9) = "[Backup] " And _
wb.Saved <> True Then '変更無しなら何もせず
wb.Activate
wb.Save 'まずは保存
With udtSHFILEOPSTRUCT
.hwnd = FindWindow(strClassName, Application.Caption)
.wFunc = FO_COPY
.pFrom = wb.Path & "\" & wb.Name
.pTo = Mid(wb.BuiltinDocumentProperties(5).Value, 10)
.fFlags = FOF_NOCONFIRMATION
End With
rc = SHFileOperation(udtSHFILEOPSTRUCT) 'ファイルのコピーを実行
End If
Next
Auto_Backup_Start
'
End Sub
Sub Auto_Backup_Start() '保存の時間間隔の設定
'
BackupInterval = Now + TimeValue("00:05:00") '５分に設定（好みの時間設定にしてください） Application.OnTime EarliestTime:=BackupInterval, Procedure:="AutoBackup"
'
End Sub
Sub Auto_Backup_Stop() '自動保存＆バックアップ機能をストップする場合はこのマクロを実行してください
'
Application.OnTime EarliestTime:=BackupInterval, Procedure:="AutoBackup", _
Schedule:=False
'
End Sub
|
|
まず、自動保存とバックアップをしたいファイルを開いている状態で、 BackUpFileNameSet を実行します。そうすると、下図のようにバックアップ先ファイルの指定ダイアログボックスが開きますので、  ここでドライブ・フォルダ・ファイル名を指定します。ファイル名は今のファイル名と別にしても問題ありません。 「保存(S)」を押すと、確認メッセージを表示（下左図）して、プロパティの「コメント(C)欄」に指定したバックアップ先のドライブ・フォルダ・ファイル名を格納します。   ファイルに対する設定はこれだけです。 あとは、personal.xls が開いている全てのファイル（ブック）を調べ、 ・プロパティのコメント欄に "[Backup] " という文字が入っていて、 ・更新されている（更新後セーブされていない状態）のファイルがあったら、 ・まず自分自身をセーブし、 ・その後、コメント欄に指定されているドライブ・パス・ファイル名にコピーする という処理を一定時間間隔（上のマクロ例では５分に設定）で繰り返します。 したがって、自分で自発的に「上書き保存」を行った場合は、上のマクロでのバックアップはされません。また、プロパティのコメント欄に何か書き込まれていても、その先頭が "[Backup] " という文字列でなければ、このマクロの処理対象となりません。 つまり、自動保存とバックアップの対象から外したければ、「ファイル(F)」 「プロパティ(I)」 でプロパティを開き、「コメント(C)」欄を削除してください。 または、 Auto_Backup_Stop マクロを実行すると、プロパティのコメント欄の設定を残したままで自動保存とバックアップ処理は行われなくなります。（ただし、EXCELを再起動すると自動保存の設定が行われます） |
|
