ioncila
04-22-2010, 08:18 AM
Hi
Some time ago, I found this code in the web (dont know the author, sorry) to create backup files.
It works almost as I wish. I've changed it to create the ".bak" file when workbook open, to automatize the procedure whenever I open the file. However the backups are created in same location of the originals, and I want them stored in another folder, say i.e., "C:\Backups\". But I donīt know where in the code I put that piece.
Other thing, to automatically create .bak files when workbook is closing, sall I use WorkbookBeforeClose Method?
Here's the code
Private Sub Workbook_Open() 'Fazer backup
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this workbook..."
.Save
Application.StatusBar = "Saving this workbook backup..."
.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
End If
End Sub
Thanks in advance for your precious help.
Ioncila
Some time ago, I found this code in the web (dont know the author, sorry) to create backup files.
It works almost as I wish. I've changed it to create the ".bak" file when workbook open, to automatize the procedure whenever I open the file. However the backups are created in same location of the originals, and I want them stored in another folder, say i.e., "C:\Backups\". But I donīt know where in the code I put that piece.
Other thing, to automatically create .bak files when workbook is closing, sall I use WorkbookBeforeClose Method?
Here's the code
Private Sub Workbook_Open() 'Fazer backup
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
BackupFileName = BackupFileName & ".bak"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this workbook..."
.Save
Application.StatusBar = "Saving this workbook backup..."
.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
End If
End Sub
Thanks in advance for your precious help.
Ioncila