Automatically Save a Backup to Drive A

[adam]

Hi anyone,

The following code automatically saves the word document to the drive A. How could the code be changed so that the code automatically saves the workbook to the drive A?

Code: Select all

'Place all the code in Normal.Dot
 'Place this code is a Class Module named Class1 
Option Explicit Public WithEvents App As Application 
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean) 
Dim SaveCopy As  VbMsgBoxResult 
Dim Title As String Dim Prompt As String If Flag = True Then Exit Sub End If Prompt = "Do you want to save a copy to the A: drive?" Title = "Confirm Procedure" SaveCopy = MsgBox(Prompt, vbYesNo + vbQuestion, Title) If SaveCopy = vbYes Then Application.OnTime Now + TimeValue("00:00:01"), "AfterSave" End If End Sub 'Place this code in a Standard Module 
Option Explicit 

Public Flag As Boolean Sub AfterSave() Flag = True ActiveDocument.SaveAs FileName:="A:\" & ActiveDocument.Name Flag = False End Sub 'Place this code in the ThisDocument module Option Explicit Dim WdApp As New Class1 Private Sub Document_New() Set WdApp.App = Word.Application End Sub Private Sub Document_Open() Set WdApp.App = Word.Application End Sub

Any help on this would be kindly appreciated.

Thanks in advance.

[HansV]

Drive A: ? Do you still have a floppy disk drive?

[adam]

No. But could it be changed to drive E?

[HansV]

Put the following code in the ThisWorkbook module of your Personal.xlsb workbook:

Code: Select all

Public WithEvents App As Application

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim SaveCopy As VbMsgBoxResult
  Dim Title As String
  Dim Prompt As String
  If Flag = True Then
    Exit Sub
  End If
  Prompt = "Do you want to save a copy to the E: drive?"
  Title = "Confirm Procedure"
  SaveCopy = MsgBox(Prompt, vbYesNo + vbQuestion, Title)
  If SaveCopy = vbYes Then
    Application.OnTime Now + TimeValue("00:00:01"), "AfterSave"
  End If
End Sub

Private Sub Workbook_Open()
  Set App = Application
End Sub

And put the following code in a standard module in Personal.xlsb:

Code: Select all

Public Flag As Boolean

Sub AfterSave()
  Flag = True
  ActiveWorkbook.SaveAs Filename:="E:\" & ActiveWorkbook.Name
  Flag = False
End Sub

Quit and restart Excel to see the effect.

[adam]

Thanks for the help. I do really appreciate it.