File Corruption
The dreaded file corruption message happens way too often and costs lost of time and money in prodcutivity. One way to at least not lose you work so often to keep multiple versions of the code you're working on. In the Workbook_BeforeSave Event, enter the following code:
Note that the code below must be adapted to your situation and will not run as is
You must name your program program_name.000.xls. You must also modify the "I:\" references in the code and create a Backup directory. I put this code up because it's helped me, but I don't have time to generalize. If you need help drop me an Email which is on our contact page.
| <![CDATA[
'********************************************************************
' http://www.KravatzInc.com 1-866-XLS-PROG
'
' This code is copyrighted by Kravatz, Inc. (c) 2007 All Rights Reserved.
' You may use this code as long as this message appears
' There is no warranty made to the fitness or suitablilty of this code
' and by using it you hold Kravatz, Inc. harmless for any damages
' that may result from its use. This code is supplied as is.
'
'********************************************************************
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Username <> "skravatz" Then
Exit Sub
End If
Cancel = True
SaveNewVersion
MoveOldVersionsToBackup
End Sub
]]> |
| <![CDATA[
'********************************************************************
' http://www.KravatzInc.com 1-866-XLS-PROG
'
' This code is copyrighted by Kravatz, Inc. (c) 2007 All Rights Reserved.
' You may use this code as long as this message appears
' There is no warranty made to the fitness or suitablilty of this code
' and by using it you hold Kravatz, Inc. harmless for any damages
' that may result from its use. This code is supplied as is.
'
'********************************************************************
Sub SaveNewVersion()
'Ctrl+Shift+S
'Gets called via the workbook.beforeSave event
Dim sName As String, sRoot As String
Dim iVersion As Integer
Dim sSave As String
Dim bEvents As Boolean
bEvents = Application.EnableEvents
Application.EnableEvents = False
sName = ThisWorkbook.Name
iVersion = Val(Right(sName, 7))
iVersion = iVersion + 1
sRoot = Mid(sName, 1, Len(sName) - 7)
sSave = "I:\" & sRoot & Format(iVersion, "000") & ".xls"
ActiveWorkbook.SaveAs sSave
MsgBox "File saved as " & sSave
Application.EnableEvents = bEvents
End Sub
]]> |
| <![CDATA[
'********************************************************************
' http://www.KravatzInc.com 1-866-XLS-PROG
'
' This code is copyrighted by Kravatz, Inc. (c) 2007 All Rights Reserved.
' You may use this code as long as this message appears
' There is no warranty made to the fitness or suitablilty of this code
' and by using it you hold Kravatz, Inc. harmless for any damages
' that may result from its use. This code is supplied as is.
'
'********************************************************************
Sub MoveOldVersionsToBackup()
'Ctrl+Shift+S
'Gets called via the workbook.beforeSave event
Dim sName As String, sRoot As String
Dim iVersion As Integer
Dim sSave As String
Dim bEvents As Boolean
Dim sBackup As String
Dim i As Long
bEvents = Application.EnableEvents
Application.EnableEvents = False
sName = ThisWorkbook.Name
iVersion = Val(Right(sName, 7))
For i = iVersion - 1 To 1 Step -1
sRoot = Mid(sName, 1, Len(sName) - 7)
sSave = "I:\" & sRoot & Format(i, "000") & ".xls"
sBackup = "I:\Backup\" & sRoot & Format(i, "000") & ".xls"
On Error Resume Next
Name sSave As sBackup
If Err = 0 Then
'ok file not found
ElseIf Err = 53 Then
AppMsgbox "Old versions backed up"
Application.EnableEvents = bEvents
Exit Sub
Else
AppMsgbox Err & " " & Error
Stop
End If
Next
'MsgBox "Done"
Application.EnableEvents = bEvents
End Sub
]]> |
|
