Disable 'Save' and 'Save As' dialogs

[perhol]

mikerickson helped me with a similar question in this thread:

http://www.vbaexpress.com/forum/showthread.php?p=143854#post143854


But in some instances it do not function as required, and now i need to redirect both 'File -> Save', 'File -> SaveAS' and the icon 'Save' in Standard Toolbar to a sub Test_Navn if macros is enabled.

This is Workbook_BeforeSave code
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Rem if SaveAs is in progress
Application.EnableEvents = False: Rem prevent Test_Navn from triggering cascading BeforeSave's
Call Test_Navn: Rem custom save routine
Cancel = True: Rem spike normal SaveAs
Application.EnableEvents = True
End If
End Sub

And the following 7 Sub's and Functions is all code related to save.

This is a sub and a function to test if conditions is meet in 2 cells in sheet "Kasserapport"
Sub Test_Navn()
Dim ws As Worksheet
Set ws = Sheets("Kasserapport")
If Test(ws) = False Then
Call Test_G
Else
MsgBox ("Udfyld f?rst Beboernavn og Startdato.")
End If
End Sub
Function Test(ws As Worksheet) As Boolean
If ws.Range("A4") = "" Or ws.Range("A4") = "01.01.00" Or ws.Range("D2") = "" _
Or ws.Range("D2") = "V?lg Beboernavn" Then Test = True
End Function
This is a sub and a function, called by the sub 'Test_Navn'. They test if drive G: is present and ready.
Sub Test_G()
If DExist("g") = 2 Then
Call G_Exist
End If
If DExist("g") = 0 Then
Call G_Do_Not_Exist
End If
End Sub

Public Function DExist(OrigFile As String)
Dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.driveexists(OrigFile) = True Then
Set d = fs.getdrive(OrigFile)
DExist = 1
If d.isready = True Then
DExist = 2
Exit Function
End If
Else
DExists = 0
End If
End Function
This is a sub and function called if drive G: is present and ready.
Sub G_Exist()
With Sheets("Kasserapport")
ActiveWorkbook.SaveAs CheckMakePath("G:\" & _
Sheets("Kasserapport").Range("H4").Text & "-huset" & "\" & "Beboere" & "\" & _
Sheets("Kasserapport").Range("D2").Text & "\" & "Regnskab" & "\" & _
Format(Sheets("Kasserapport").Range("A4"), "yyyy")) & _
"Regnskab " & Format(Sheets("Kasserapport").Range("A4"), "mm-yyyy") & _
" " & Sheets("Kasserapport").Range("D2").Text & ".xls"
End With
MsgBox " Regnskabet er gemt" + Chr(10) + _
"i beboerens regnskabsmappe p? G:-drevet"
End Sub
Function CheckMakePath(ByVal vPath As String) As String
Dim PathSep As Long, oPS As Long
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
PathSep = InStr(3, vPath, "\") 'Position af drev-seperatoren i stien
If PathSep = 0 Then Exit Function 'Ugyldig sti
Do
oPS = PathSep
PathSep = InStr(oPS + 1, vPath, "\") 'Position af folder
If PathSep = 0 Then Exit Do
If Len(Dir(Left(vPath, PathSep), vbDirectory)) = 0 Then Exit Do 'check stien
Loop
Do Until PathSep = 0
MkDir Left(vPath, PathSep)
oPS = PathSep
PathSep = InStr(oPS + 1, vPath, "\")
Loop
CheckMakePath = vPath
End Function
This is a sub called if drive G: is not present and ready.
Sub G_Do_Not_Exist()
ActiveWorkbook.SaveAs "C:\Documents and Settings\" & Environ("username") & _
"\Desktop\" & "Regnskab " & Format(Sheets("Kasserapport").Range("A4"), "mm-yyyy") & _
" " & Sheets("Kasserapport").Range("D2").Text & ".xls"
MsgBox "Der er ikke forbindelse til G:-drevet." + Chr(10) + _
"Regnskabet er gemt p? skrivebordet.", vbExclamation, ""
End Sub

[Zack Barresse]

Hi there,

Maybe you didn't see my post in your other thread? Pretty sure it solves it for you (still).

[perhol]

Only takes care of 'File -> Save AS', not 'File -> Save' and the icon 'Save' in Standard Toolbar.
Same as the post from mikerickson do.

Also, when 'File -> Save AS' is run and file by chosen name exists already in folder and 'Cancel' is chosen, the sub fails and the whole path and filename is highlighted whether drive G: exists or not.

I need to redirect both 'File -> Save', 'File -> SaveAS' and the icon 'Save' in Standard Toolbar.

Also, if save for some reason fails, i need at least a message to appear.

[Zack Barresse]

It is the BeforeSave event... maybe you can tell me how it doesn't take care of it???

[perhol]

Yours:


SaveAsUI = False
Cancel = True
and mikerickson's
If SaveAsUI Then
both say SaveAsUI

I guess that is the reason it do not take care of 'File -> Save' and 'Save' icon i the standard toolbar.

[Simon Lloyd]

You could try this:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
End Sub


Private Sub Workbook_Open()
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As...").Enabled = False
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save").Enabled = False
End Sub

[perhol]

When the lines
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As...").Enabled = False
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save").Enabled = False is added to my Private Sub Workbook_Open() and i run the file i get this error:

Run-time error '5':
Invalid procedure call or argument

Debug highlight this line:
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As...").Enabled = False
When this line is remmed out and and i run the file again, the same error is repported, and the next line is highlighted.

When your lines added this is how my Workbook_Open and Workbook_BeforeSave events look like:
Private Sub Workbook_Open()
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As...").Enabled = False
Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save").Enabled = False
AddIns("Analysis ToolPak").Installed = True
AddIns("Analysis ToolPak - VBA").Installed = True
AddIns("Pop-up Calendar").Installed = True
Call OpretMenu
With Sheets("Kasserapport")
.Activate
If .Range("D2") = "V?lg Beboernavn" Or .Range("A4") = "01.01.00" Then
.Range("D2").ClearContents
.Range("A4").ClearContents
.Range("D2").Select
MsgBox ("Udfyld f?rst Beboernavn og Startdato.")
End If
End With
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Cancel = True: Rem spike normal SaveAs
Call Test_Navn
End If
End Sub

[Simon Lloyd]

I ran this in my workbook and it performed fine:

Private Sub Workbook_Open()
With Application
.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As...").Enabled = False
.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save").Enabled = False.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As Web Page...").Enabled = False
End With
End Sub
you must make sure that the Controls("nnnn nn...") is exactly the same as in your workbook, you can check by going to File and look at the options there!

[perhol]

Well, it kind of works the way i want it to.
Except, that i did not want the menuitems to be disabled, just to be redirected to a macro.
And that i also wanted to do with the icon 'Save' in Standard Toolbar.
Is it possible?
I can post the workbook.

[perhol]

Also, when 'File -> Save AS' is run and file by chosen name exists already in folder and 'Cancel' is chosen, the sub still fails and the whole path and filename in the sub that do the saving is highlighted whether drive G: exists or not.

[mikerickson]

Does my macro work for you when the test is removed? With that in place, the user should never have an opportunity to press Cancel.

[perhol]

Lost track, i think!
What test would that be?
Going to bed. Here it is 03:41 in the morning.
Returning to morrow!

[mikerickson]

From the code in the OP, it looks like replacing this in the ThisWorkbook module.Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Application.EnableEvents = False: Rem prevent Test_Navn from triggering cascading BeforeSave 's
Call Test_Navn: Rem custom save routine
Cancel = True: Rem spike normal Save / SaveAs
Application.EnableEvents = True

End Sub


And adding these two lines, will prevent the user from having the option to cancel. If a duplicate file name already exists, this will overwrite it.
Sub G_Do_Not_Exist()

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs "C:\Documents and Settings\" & Environ("username") & _
"\Desktop\" & "Regnskab " & Format(Sheets("Kasserapport").Range("A4"), "mm-yyyy") & _
" " & Sheets("Kasserapport").Range("D2").Text & ".xls"
MsgBox "Der er ikke forbindelse til G:-drevet." + Chr(10) + _
"Regnskabet er gemt p? skrivebordet.", vbExclamation, ""

Application.DisplayAlerts = True

End Sub

Sleep well.

[Zack Barresse]

The SaveAsUI is only a boolean for the dialog box. I don't think you're really understanding this here. Anytime you save - with either the Save or SaveAs (which the only difference is that it brings up the saveas dialog box) - the beforesave event is fired. Thus trapping the event will take into account ALL types of saving. ....
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
SaveAsUI = False
Cancel = True
'Do something here
End Sub

This is how you control the save function. This says the SaveAsUI is false, so do not show the dialog box, and Cancel is true, so don't perform the native action of saving, then you tell it to do something, i.e. go to your own sub. Just don't forget to handle saving, as you've effectively dropped it by cancelling.

[perhol]

I also don't really think i understand the funktion of the SaveAsUI.
I will try to explain what happened in my workbook.

My own save-procedure read the value of 2 cells in the sheet "Kasserapport" and use these values to chose (and, if necessary, create) prober folder, and use same values to name the file.

What i try to do, is making it impossible for the user to save using standar method, and instead use my method.
Using the Workbook_BeforeSave event as described by, among others, you, did the trick for some instances of save, and not for other.

When my file was started from an *.xlt, it prompted user to fill the 2 cells necessary to chose folder and filename. After that, chosing any method of save, my own or any of Excel's native methods, tricked my own save procedure to run.

So far so good.
But when first named and saved, choosing File -> Save or the Save (floppydisk) icon on the standard toolbar will just save with the filename and in the folder already made, no matter what is filled in the 2 required cells.

The file is an monthly account sheet to deliver account for each of 28 physical and mental disabled adult citizens, and no sheet is completed at once. This meens that a sheet must be opened more times. When finally completed and saved, it is possible to chose a function to make a sheet for a new month, it copy the final balance to the start balance and clears all other lines except the name og the citizen the startdate and the new start balance.
Most of the employees are brilliant educators, but less brilliant at a computer or any sort of accounting to say the least.

I have been trying to explain sensible folder structure and naming on many occasions without it being successful.
This have caused many accountsheets to be overwritten with empty sheets or sheets belonging to another citizen, account sheets and other files to be spread out overall on local harddisks and our fileserver.
This is what i am trying to avoid with less than good success.

This was a longer and probably unnecessary explanation.
Let me now turn to explain what I have done to cope with the problem.

I have 'grayed out' File -> save' and removed the Save (floppydisk) icon on the standard toolbar with these lines in the Private Sub Workbook_Open():
With Application
.CommandBars("Worksheet Menu Bar").Controls("Filer").Controls("Gem").Enabled = False
.CommandBars("Standard").Controls(3).Delete
End With
I have reinstated these things with these lines in the Private Sub Workbook_BeforeClose(Cancel As Boolean):
With Application
.CommandBars("Worksheet Menu Bar").Controls("Filer").Controls("Gem").Enabled = True
.CommandBars("Standard").Reset
End With
'
I have found no way to disable the hotkey combination [CTRL+S], so this i have to let be. I can hope that the employees computer-knowledge don't let them remember this hotkey combination.

The error when cancelling the Save when file already exists have been taking care of with some errorhandling like this:
On Error GoTo Err2
'Some Save code
MsgBox "File have been saved in citizens account folder", vbExclamation, ""
Exit Sub
Err2:
MsgBox "The account sheet was not saved." + Chr(10) + _
"The save event was canceled by user.", vbExclamation, ""
Exit Sub
As i obviously don't understand all about VBA or even Excel, i hope for some testing by more savvy persons than me.
I attach the file here. All passwords have been removed. The file have a size of 361 kb.
I have had to rename it to xls because 'vbax do not allow xlt files.

[Simon Lloyd]

Jeeeeez! why not post your workbook here then things will be clearer!