Canceling Workbook Before_Save event

[acampbell012]

Hello All,

First, thank you to all the contributors to this site as it has been a
valuable resource for learning and coding in VBA.

I have a problem I have not been able to resolve. I have the code
below in a workbook (Voucher Form.xls) that is saved on a network
drive. It is a read only workbook, reps. in our call center use to
process customer transactions.

I want to prevent the rep from saving the file within network directory
the template is stored in. I am using the BeforeSave event to give the
rep an opportunity to save to the designated desktop folder or cancel
the save operation.

Problem: the BeforeSave event does not appear to be the correct place
for this code. It ignores the cancel selection and continues the save
operation.

Any suggestions on the placement or modification of this code so that
Cancel exists the sub would be greatly appreciated. Thanks.

Alan


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
'This macro and function force file save location and default name
Dim strPath
Dim fname
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "File will be saved to a ""Saved Vouchers"" folder" & vbCr & _
"on your desktop. Do you wish to Continue?"
Style = vbYesNo + vbExclamation + vbDefaultButton2 ' Define buttons.
Title = "File Save" ' Define title.
'Help = "DEMO.HLP" ' Define Help file.
'Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then ' User chose Yes.
Exit Sub
Else ' User chose No.
fname = Range("Acct_1").Value & " " & ThisWorkbook.Name
strPath = Environ("userprofile") & Environ("HomePath") & _
"Desktop\"
On Error Resume Next
MkDir strPath & "Saved Vouchers"
strPath = Environ("userprofile") & Environ("HomePath") & _
"Desktop\Saved Vouchers\"
ActiveWorkbook.SaveAs _
Filename:=strPath & fname, _
FileFormat:=xlNormal, CreateBackup:=False
End If
End Sub
Private Sub Create_Dir()
Dim wShell, fso, strFldr As String, MyDrive As String
Set wShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
strFldr = wShell.SpecialFolders("Desktop")
MyDrive = Left(strFldr, 3)
ChDrive (MyDrive)
ChDir (strFldr)
fso.CreateFolder ("Saved Vouchers")
End Sub

 

[Tom Ogilvy]

You have to set cancel to True if you want to cancel the save that triggered
the event:

Private Sub Workbook_BeforeSave(ByVal _
SaveAsUI As Boolean, Cancel As Boolean)
'This macro and function force file save location and default name
'
' Set Cancel to True
'
Cancel = True

Dim strPath
Dim fname
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "File will be saved to a ""Saved Vouchers"" folder" & vbCr & _
"on your desktop. Do you wish to Continue?"
Style = vbYesNo + vbExclamation + vbDefaultButton2 ' Define buttons.
Title = "File Save" ' Define title.
'Help = "DEMO.HLP" ' Define Help file.
'Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then ' User chose **Yes** No.
Exit Sub
Else ' User chose **No** Yes.
fname = Range("Acct_1").Value & " " & ThisWorkbook.Name
strPath = Environ("userprofile") & Environ("HomePath") & _
"Desktop\"
On Error Resume Next
MkDir strPath & "Saved Vouchers"
strPath = Environ("userprofile") & Environ("HomePath") & _
"Desktop\Saved Vouchers\"
'
' stop events so you don't come back here
'
Application.EnableEvents = False

ActiveWorkbook.SaveAs _
Filename:=strPath & fname, _
FileFormat:=xlNormal, CreateBackup:=False
'
' Restart Events
'
Application.EnableEvents = True


End If
End Sub

 

[acampbell012]

Tom,

Thanks. Your simple changes worked great. As I read from so many other
novice users of this site, I was looking for the complicated solution.