How to autobackup Workbook using VBA code..

[Nitesh Khot]

Hi..

I am looking for vba code which is autobackup excel file (in background as per interval) and save in target folder. If excel get crash then when I open again excel then it should ask for recovery of temp file.

or

if my excel stops or Not responding then automatially save file & wait till excel starts responding..


Thanks inn advance..

 

[vletm]

Have You tested this?

and one code for 'automatic autobackup' I could show.
but ... 'when I open again excel...' that will do Excel not code.
... that Your the last sentence is interesting ... forecasting?

 

[Nitesh Khot]

Yes ..But Can you show me code for this....this will help me for anither project

 

[vletm]

Of course, I can show sample of code.

'   This needs "init" sheet for control extra backups

'   >>  ThisWorkbook

Sub Do_BackUp()
    Application.ScreenUpdating = False

    B_num = Sheets("init").Range("A1")
    If B_num = Empty Or B_num > 99 Then B_num = 0
    B_num = B_num + 1
    Sheets("init").Range("A1") = B_num
    If B_num < 10 Then B_num = "0" & B_num
    ThisWorkbook.Save
   
    BackUp_Path = ActiveWorkbook.Path & Application.PathSeparator & "backup"
    BackUp_File = BackUp_Path & Application.PathSeparator & B_num & "_" & ActiveWorkbook.Name
       
    CAN_BACKUP = True
    On Error Resume Next
        IS_PATH = Dir(BackUp_Path, vbDirectory)
    If Err.Number <> 0 And IS_PATH = "backup" Then
        CAN_BACKUP = False
        If MsgBox("Make the BackUpFolder?", vbYesNo, "BackUp") = vbYes Then
            MkDir BackUp_Path
            On Error Resume Next
                IS_PATH = Dir(BackUp_Path, vbDirectory)
            If Err.Number <> 0 And IS_PATH = "backup" Then
                MsgBox ("Couldn't make backup-folder!" & Chr(13) & Chr(13) & BackUp_Path)
            Else
                CAN_BACKUP = True
            End If
        End If
    End If
    If CAN_BACKUP Then ActiveWorkbook.SaveCopyAs (BackUp_File)
    Application.Wait (Now + TimeSerial(0, 0, 1))
End Sub

Sub Do_Extra_BackUp()
    Sheets("init").Range("A6") = Sheets("init").Range("A6") + 1
    If Sheets("init").Range("A6") > 10 Then
        Application.ScreenUpdating = True
'   indication ON
'        org_color = Sheets("prod").Range("B6").Interior.Color
'        Sheets("prod").Range("B6").Interior.ColorIndex = 6
        Do_BackUp
        Sheets("init").Range("A6") = Empty
'   indication OFF
'        Sheets("prod").Range("B6").Interior.Color = org_color
        Application.ScreenUpdating = True
    End If
End Sub



'   >>  Sheets

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
     
'   Your Code here
   
    ThisWorkbook.Do_Extra_BackUp
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub