Microsoft Office Tutorials and References
In Depth Information
Saving a Backup Copy of a Workbook
'Make sure that there is a trailing backslash¶
If Right$(Path, Len(Application.PathSeparator)) <> _¶
Application.PathSeparator Then¶
Path = Path & Application.PathSeparator¶
End If¶
If History <= 0 Then¶
'Don't keep a history, overwrite if the file exists¶
'Continue if error occurs¶
On Error Resume Next¶
SetAttr PathName:=Path & Book.Name, Attributes:=vbNormal¶
On Error GoTo err_h¶
Book.SaveCopyAs Path & Book.Name¶
'Mark it as read only¶
SetAttr PathName:=Path & Book.Name, Attributes:=vbReadOnly¶
Else¶
'Store versions on the path¶
'First, get the name of the file without the extension¶
Extension = GetExtension(Book.Name)¶
FileNoExtension = Left$(Book.Name, _¶
Len(Book.Name) - Len(Extension) - 1)¶
'Delete the oldest version available¶
'Continue if error occurs¶
On Error Resume Next¶
SetAttr PathName:=Path & FileNoExtension & "-" & Format$( _¶
History, "000") & "." & Extension, Attributes:=vbNormal¶
Kill PathName:=Path & FileNoExtension & "-" & Format$( _¶
History, "000") & "." & Extension¶
On Error GoTo err_h¶
'Now rename any existing older versions¶
For i = History - 1 To 1 Step -1¶
'Name of the file being moved¶
TempFile = Path & FileNoExtension & "-" & Format$(i, _¶
"000") & "." & Extension¶
'Does the file exist?¶
If FileExists(TempFile) Then¶
'Rename it¶
Name TempFile As Path & FileNoExtension & "-" & Format$( _¶
i + 1, "000") & "." & Extension¶
End If¶
Next i¶
'Finally, save the workbook !¶
Book.SaveCopyAs Path & FileNoExtension & "-001." & Extension¶
'Mark it as read only¶
SetAttr PathName:=Path & FileNoExtension & "-001." & _¶
Extension, Attributes:=vbReadOnly¶
End If¶
Exit Sub¶
err_h:¶
MsgBox "Error " & Err.Number & ", " & Err.Description, _¶
vbCritical¶
End Sub¶
Exl
Search JabSto ::




Custom Search