Автобэкапы в Ворде.

[Линда Кайе]

#post-id: 3730-12-53
#original-date: 12.10.2010 Tue
#original-time: 12:53 PM
#original-day:  3730
#original-host: WinXP Prof SP3 (Build 2600)

Посмотрим, как оно поведёт себя в Ворде, но в Дане и Notepad2 я это использую постоянно, думаю и в VB IDE прикрутить...

Option Explicit

Dim WithEvents DocEvents As Application

'====================================================================
Private Sub Document_New()
  Set DocEvents = Application
End Sub

Private Sub Document_Open()
  Set DocEvents = Application
End Sub

'====================================================================
Private Sub DocEvents_DocumentBeforeSave(ByVal Doc As Document, _
                                         SaveAsUI As Boolean, _
                                         Cancel As Boolean)
  Dim BackupPath As String
  Dim Buff() As Byte
  
  On Error Resume Next
  
  ' Хитрость. Если файл только что создан, то нам его бэкапить как
  ' раз и не надо. Его не существует.
  If Not IsFileExist(Doc.FullName) Then Exit Sub
  
  ' Этот каталог можно переопределить. Желательно чтобы он был как
  ' можно короче.
  BackupPath = "D:\Word Backups"
  
  If Not IsDirExist(BackupPath) Then MkDir BackupPath
  If Err Then
    ajpErr.ErrorDisplay Err, , , BackupPath & vbCrLf & vbCrLf & _
                                 "Can't create backup folder."
    Exit Sub
  End If
  
  If Right(BackupPath, 1) <> "\" Then BackupPath = BackupPath & "\"
  BackupPath = BackupPath & Replace( _
                                Replace( _
                                    Replace(Doc.FullName, "/", "~"), _
                                "\", "~"), _
                            ":", "~")
  
  If Not IsDirExist(BackupPath) Then MkDir BackupPath
  If Err Then
    ajpErr.ErrorDisplay Err, , , BackupPath & vbCrLf & vbCrLf & _
                                 "Can't create backup folder."
    Exit Sub
  End If
  
  If Right(BackupPath, 1) <> "\" Then BackupPath = BackupPath & "\"
  BackupPath = BackupPath & Format(Now, "yyyy\-mm\-dd hh\-nn\-ss") & ".BAK"
  
  ' Магия. CopyFile пытается открыть файл с записью (нафига?),
  ' поэтому ничего у него не получается. Поэтому сделаем вот
  ' так: сами прочитаем и сами сохраним...
  Buff = ajpFSO.GetFileB(Doc.FullName, True)
  If Err Then
    ajpErr.ErrorDisplay Err, , , Doc.FullName & vbCrLf & vbCrLf & _
                                 "Can't read source file." & _
                                 vbCrLf & vbCrLf & BackupPath
    Exit Sub
  End If
  
  ajpFSO.PutFileB BackupPath, Buff, True
  If Err Then
    ajpErr.ErrorDisplay Err, , , BackupPath & vbCrLf & vbCrLf & _
                                 "Can't write file to backup location." & _
                                 vbCrLf & vbCrLf & BackupPath
  End If
End Sub

Private Function IsDirExist(ByVal Path As String) As Boolean
  Dim TXT As String
  
  On Error Resume Next
  
  TXT = Dir(Path, vbArchive + vbDirectory + vbHidden + _
                  vbNormal + vbReadOnly + vbSystem)
  IsDirExist = CBool(TXT <> "")
End Function

Private Function IsFileExist(ByVal Path As String) As Boolean
  Dim TXT As String
  
  On Error Resume Next
  
  TXT = Dir(Path, vbArchive + vbHidden + _
                  vbNormal + vbReadOnly + vbSystem)
  IsFileExist = CBool(TXT <> "")
End Function

Суть такова. Перед каждым сохранением в папке D:\Word Backups создаётся папка, с полным именем сохраняемого файла. Потом туда копируется он, но с датой вместо имени. И так каждый раз.

Устанавливается просто: открывается на редактиврование Normal.DOT, там ищется модуль ThisDocument, ну и вставляется туда этот код. Собственно, всё ^^