Trap on close event and control save

[XP]

Using Office 2003 and Windows XP;

I am trying to trap the Workbook_BeforeClose event so that I can substitute
a call to my own save function, see below:

Public Function FileSavePrompt(argPath As String, argName As String) As Long
'SUPPLY A DEFAULT FILE NAME AND PROMPT THE USER TO SAVE THE FILE;
Application.ScreenUpdating = True
Dim lResponse As Long
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.ButtonName = "SAVE!"
.InitialView = msoFileDialogViewDetails
.InitialFileName = argPath & argName
.Title = "SAVE FILE AS EXCEL"
End With
lResponse = Application.FileDialog(msoFileDialogSaveAs).Show
'Save the file if user did not click 'Cancel'
If lResponse = -1 Then Application.FileDialog(msoFileDialogSaveAs).Execute
End Function

This function allows me to capture and enter a custom suggested file name
for the user. However, I cannot get this to function correctly. In many
cases, it errors so badly, I get the: "Do you want to send this error to
Microsoft" message.

Can someone tell me how to invoke this correctly? I've tried all
combinations of Cancel = True and Application.EnableEvents = False, but I
must not be putting my code in the right place or something. Any help
appreciated.

Thanks much in advance.

 

[Chip Pearson]

Try something like the following. Put the following code in the ThisWorkbook
code module (it must be in the ThisWorkbook module).

Private Function MySave(DefaultDir As String) As String

Dim FName As Variant
Dim CDir As String

' save the current directory
CDir = CurDir
' If DefaultDir specifies an existing directory,
' change to that directory
If DefaultDir <> "" Then
If Dir(DefaultDir, vbDirectory) <> vbNullString Then
ChDrive DefaultDir
ChDir DefaultDir
End If
End If
' get the filename
FName = Application.GetSaveAsFilename()
If FName = False Then
' user cancelled -- return empty string
MySave = vbNullString
Else
' user clicked OK -- return FileName
MySave = FName
End If
' restore directory settings
ChDrive CDir
ChDir CDir
End Function

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim FName As String

' get a new filename from the user
FName = MySave(DefaultDir:=ThisWorkbook.Path)
If FName = vbNullString Then
' user cancelled -- get out now
Exit Sub
End If
On Error GoTo ErrH:
With Application
' turn off alerts and events
.DisplayAlerts = False
.EnableEvents = False
' save the file
ThisWorkbook.SaveAs Filename:=FName
ErrH:
' restore alerts and events
.DisplayAlerts = True
.EnableEvents = True
End With

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[XP]

Hi CP,

Thanks for the post.

Your code works, UNLESS I put in my shut down routine, so your code helped
me pinpoint where the problem is. Here is my code, all I want it to do is
hide all sheets except a "splash" screen...do you see any problems here
(nothing is password protected)??? :

Public Function WorkbookSetAppearanceClose()
'RESET THE DESIRED APPEARANCE OF THE WORKBOOK ON CLOSE
ThisWorkbook.Unprotect
ThisWorkbook.Worksheets(gcsSheetSplash).Visible = True
Sheets(gcsSheetSplash).Activate
ActiveSheet.Unprotect
Application.Goto Range("A1"), True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True,
UserInterfaceOnly:=True
If Worksheets(gcsSheetForm).Visible = True Then
ThisWorkbook.Worksheets(gcsSheetForm).Visible = xlVeryHidden
If Worksheets(gcsSheetHelp).Visible = True Then
ThisWorkbook.Worksheets(gcsSheetHelp).Visible = xlVeryHidden
If Worksheets(gcsSheetList).Visible = True Then
ThisWorkbook.Worksheets(gcsSheetList).Visible = xlVeryHidden
ActiveWorkbook.Protect Structure:=True, Windows:=False
End Function

 

[Chip Pearson]

You could clean up and simplify the code to

Sub CloseItDown()
Dim WS As Object
' you always need one sheet visble. make gcsSheetSplash visible
' before hiding others
ThisWorkbook.Worksheets(gcsSheetSplash).Visble = xlSheetVisible
For Each WS In ThisWorkbook.Sheets
If StrComp(WS.Name, gcsSheetSplash, vbTextCompare) <> 0 Then
WS.Visble = xlSheetHidden ' or xlSheetVeryHidden if preferred
End If
Next WS
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)