Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 137
Default How to create backups of your workbooks as you open and as you close

If you're working on an important workbook and wish to keep a running list with separate incremental backups, you can copy this code to your 'ThisWorkbook' section in the VBE

Note: This will not be executed if the file is opened as READONLY (what's the point, right?)
Note: A backup is automatically made upon opening the workbook (not if the file was opened READONLY)
Note: This creates a full backup of the workbook including all macros
Note: Backups are identified with a Date and Time suffix helping to identify them
Note: Upon Saving or Closing you are prompted for an optional comment which might help to identify the changes you made during your edit.


Setup: Change the BackupDir const to your target folder (which must exist)


'**** Place in ThisWorkbook
'**** Copy from here down

Option Explicit

'Author: Greg Glynn

Const BackupDir = "P:\Backups\" '*** Change this to your backups folder which can be different from your workbook folder

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim BackupFileName As String, BackupDateTime As String, BackupUser As String, BackupFileType As String
Dim sh As Worksheet, wkb As Workbook
Dim Comment As String

Comment = ""

Application.Caption = "*** Auto Backup ***"
DoEvents
Application.EnableEvents = False
Application.ScreenUpdating = False

'Backup the data if the sheet was not opened in ReadOnly mode
If ThisWorkbook.ReadOnly = False Then

Comment = InputBox("Add a comment?")
If Comment < "" Then
Comment = " - " & Replace(Comment, "/", "-")
End If

'Create a backup
BackupFileName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".xls") - 1)
BackupDateTime = " " & Format(Now(), "YYYY-MM-DD hh-mm-ss")
BackupUser = " " & Environ$("Username")
BackupFileType = "." & Mid(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".xls") + 1, 999)
On Error Resume Next
ActiveWorkbook.SaveCopyAs BackupDir & BackupFileName & BackupDateTime & BackupUser & Comment & BackupFileType

Application.StatusBar = "Saved " & BackupFileName & " " & Format(FileLen(BackupDir & BackupFileName & BackupDateTime & BackupUser & Comment & BackupFileType), "#,#") & " bytes."
On Error Resume Next
'Will be saved anyway by virtue of the "Workbook_BeforeSave" function
'ActiveWorkbook.Save

End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Caption = ""
End Sub

Private Sub Workbook_Open()

Dim BackupFileName As String, BackupDateTime As String, BackupUser As String, BackupFileType As String
Dim sh As Worksheet, wkb As Workbook

Application.Caption = "*** Auto Backup ***"
DoEvents
Application.EnableEvents = False
Application.ScreenUpdating = False

'Backup the data if the sheet was not opened in ReadOnly mode
If ThisWorkbook.ReadOnly = False Then

'Create a backup
BackupFileName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".xls") - 1)
BackupDateTime = " " & Format(Now(), "YYYY-MM-DD hh-mm-ss")
BackupUser = " " & Environ$("Username")
BackupFileType = "." & Mid(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".xls") + 1, 999)
On Error Resume Next
ActiveWorkbook.SaveCopyAs BackupDir & BackupFileName & BackupDateTime & BackupUser & BackupFileType
On Error Resume Next
ActiveWorkbook.Save

End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Caption = ""

End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default How to create backups of your workbooks as you open and as you close

Way too much repetitious code making for way too much maintenance,
possibly. I'd go with something more like this...

Option Explicit

' Revised from original code by Greg Glynn

Const msPath$ = "E:\Backups\" '*** Change this to suit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
'Backup the data if the sheet was not opened in ReadOnly mode
If ThisWorkbook.ReadOnly Then Exit Sub

Dim sComment$
Comment = InputBox("Add a comment?")
If Comment < "" Then
Comment = " - " & Replace(Comment, "/", "-")
End If
'Create a backup
CreateBackup Comment

End Sub

Private Sub Workbook_Open()
'Backup the data if the sheet was not opened in ReadOnly mode
If Not ThisWorkbook.ReadOnly Then CreateBackup

End Sub

Private Sub CreateBackup(Optional Comment$)
Dim sFileName$, sFile$

DoEvents
With Application
.EnableEvents = False: .ScreenUpdating = False: .Caption = "***
Auto Backup ***"
End With

sFileName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name,
".") - 1)
sFile = msPath & " " & sFileName & " " & Format(Now(), "YYYY-MM-DD
hh-mm-ss")
sFile = sFile & " " & Environ$("Username")
sFile = sFile & Comment & Mid(ActiveWorkbook.Name,
InStrRev(ActiveWorkbook.Name, "."))
On Error Resume Next
ActiveWorkbook.SaveCopyAs sFile

Application.StatusBar = "Saved " & sFileName & " " &
Format(FileLen(sFile), "#,#") & " bytes."

With Application
.EnableEvents = True: .ScreenUpdating = True: .Caption = ""
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

  #3   Report Post  
Banned
 
Posts: 1
Default

thèm mẹo web chuẩn seo
thèm thuồng mẹo web tại huyện nh* phái l* nh*ch mùa còn ng*y c*ng vạc triển bạo Dich vu thiet ke web mẽ thứ cạc một v*y, l*m ty đặt trả lời ứng hẹp đủ nhu cầu mực t*u bừa phần đông doanh nghiệp, cá nhân, dải chức bây giờ.
sầu mưu web qu*n Nh* phe
L* một bởi cung gấp xịch vụ m*ng chước web chuẩn mực SEO siêng nghiệp, oai t*n, giá rẻ chúng tui tự h*o vẫn váng vất mưu xuể vấy nghìn web chất lượng với m*t lớp bao phủ sóng trên rõ quốc. tốt khách d*nh đánh v* rất cao v* tin cẩn trong suốt thời kì trải qua.
dịch mùa bòn chước web mức chúng mình tiễn lại những v* trị khôn xiết lớn to cho doanh nghiệp, giúp gia tăng dịp cộng tác kinh dinh tặng danh thiếp l*m ty, doanh nghiệp trên tuyền quốc v* th*m tr* cả trong đ*t vực.
cùng h*ng ngũ nhân viên chăm nghiệp v* việc áp dụng những đả nghệ mới nhất giúp xóa tan trớt trên dưới cách địa lý m* chồng cây web phăng hết hình thức lẫn nội dung đều đảm bảo, trả lời ứng đúng nhu cầu hạng khách khứa d*nh dấp. đồng ho*i thấp nhất v* nhỉnh vụ khách quán tốt nhất, chúng mình thoả đeo lại *ch lợi tối da biếu cạc doanh nghiệp.
hả liên quan đồng chúng tôi hồi nhiều nhu cầu tốt nhằm hưởng những ưu thết đãi k*n biệt không tiền khoáng h*u v* xịch mùa tơ m*ng mão web v* rẻ, chăm nghiệp nhất của thèm thuồng mão web chuẩn SEO.
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 538
Default How to create backups of your workbooks as you open and as you close

Greg Glynn wrote:

If you're working on an important workbook and wish to keep a running
list with separate incremental backups, you can copy this code to your
'ThisWorkbook' section in the VBE

Note: This will not be executed if the file is opened as READONLY
(what's the point, right?) Note: A backup is automatically made upon
opening the workbook (not if the file was opened READONLY) Note: This
creates a full backup of the workbook including all macros Note:
Backups are identified with a Date and Time suffix helping to identify
them Note: Upon Saving or Closing you are prompted for an optional
comment which might help to identify the changes you made during your
edit.


Here's what I do. My needs are simple, but if I save any changes, no matter
how the workbook was opened, I want a backup.

#If Win64 Then
Private Declare PtrSafe Function CopyFile Lib "kernel32" _
Alias "CopyFileA" ( ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
#Else
Private Declare Function CopyFile Lib "kernel32"
Alias "CopyFileA" ( ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
#End If

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Const TARGETDIR As String = "D:\incremental\"
dot = InStrRev(Me.Name, ".")
If dot < 1 Then dot = Len(Me.Name) + 1
tmp$ = Left$(Me.Name, dot - 1) & Format$(Now, " (yyyymmdd-hhmmss)") & _
Mid$(Me.Name, dot)
CopyFile Me.FullName, TARGETDIR & tmp$, 0
End Sub

--
But I am what I am. And so here I stand.
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Open and Close Workbooks Tontonan Excel Programming 2 February 18th 09 10:41 PM
Close all other open Workbooks CLR Excel Programming 4 December 5th 08 05:57 PM
Code to close many open workbooks MurrayB Excel Programming 13 September 18th 08 01:32 PM
close all open workbooks except the active one Dav[_4_] Excel Programming 3 April 6th 06 01:26 AM
Open Close workbooks bbc1 Excel Discussion (Misc queries) 2 August 28th 05 11:24 AM


All times are GMT +1. The time now is 08:43 AM.

Powered by vBulletin® Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
Copyright 2004-2023 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"