Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Open and Close Workbooks | Excel Programming | |||
Close all other open Workbooks | Excel Programming | |||
Code to close many open workbooks | Excel Programming | |||
close all open workbooks except the active one | Excel Programming | |||
Open Close workbooks | Excel Discussion (Misc queries) |