View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Use Workbook BeforeSave Event to Save Copy to Different Location

I forgot to stop the .save from calling the event:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim strPrompt As String
Dim intButtons As Integer
Dim strTitle As String

MsgBox Me.Saved

With Me
' save a copy in public folder in power vault
On Error Resume Next
.SaveCopyAs ("\\Powervault\Global Schedule BU\" & .Name)
' if error occurs notify user
If Err.Number < 0 Then
strPrompt = "The back up file for " & .Name _
& " was not saved in '\\Powervault\Global Schedule BU' folder."
strPrompt = strPrompt & " Please make a note of this and notify
Ryan."
intButtons = vbExclamation
strTitle = "Problem"
MsgBox strPrompt, intButtons, strTitle
End If
End With

'Application.EnableEvents = False
Me.Save
Application.EnableEvents = True

MsgBox Me.Saved

End Sub


Delete the msgboxes (Me.saved) when you're done testing.

RyanH wrote:

Note: This workbook has a .xla extension. Does that matter? I save this
workbook either in the immediate window or in the VBE.
--
Cheers,
Ryan

"RyanH" wrote:

I have a workbook that I would like to save a copy to a different location
everytime I save the workbook. I use the BeforeSave Event. The copy saves
perfectly but it doesn't save to its original folder, why?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim strPrompt As String
Dim intButtons As Integer
Dim strTitle As String

On Error Resume Next
With ThisWorkbook

' save a copy in public folder in power vault
.SaveCopyAs ("\\Powervault\Global Schedule BU\" & ThisWorkbook.Name)

' if error occurs notify user
If Err.Number 0 Then
strPrompt = "The back up file for " & ThisWorkbook.Name & "
was not saved in '\\Powervault\Global Schedule BU' folder."
strPrompt = strPrompt & " Please make a note of this and
notify Ryan."
intButtons = vbExclamation
strTitle = "Problem"
MsgBox strPrompt, intButtons, strTitle
End If
End With

End Sub
--
Cheers,
Ryan


--

Dave Peterson