SaveAs dialog box

[Ronio]

I have a Template (xlt) that when the user clicks the save button (on the
excel menu bar), i'm running the following code so that it will save the new
filename in a specific desired format.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fname, pname
fname = Range("SiteCity")
fname = "Charter - " & fname
Application.GetSaveAsFilename (fname)
End Sub

However it is actually saving the file twice, once from my code, then
normally from Excel as when this sub ends it follows the normal save routine
(since the user clicked the save button).
Q1: Is there any way to stop the second routine from saving the file?
Q2: Is there a way to ensure the recommend path is also set the "My
Documents"?

thx,
Ron

 

[Dave Peterson]

Actually, it's only saving the file once.

Application.getsaveasfilename doesn't actually save the file. It just returns
the filename that the user chose. It's up to you to do the save yourself.

Maybe something like:

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

Dim FName As String
Dim UserFNameChoice As Variant
Dim resp As Long

Cancel = True 'don't let excel save it

FName = Me.Worksheets("sheet1").Range("SiteCity").Value
FName = "Charter - " & FName & ".xls"

UserFNameChoice = Application.GetSaveAsFilename(InitialFileName:=FName, _
filefilter:="Excel Files, *.xls")

If UserFNameChoice = False Then
'user hit cancel, do nothing
Else
resp = vbYes
'check to see if then name already exists
If Dir(UserFNameChoice) <> "" Then
resp = MsgBox(Prompt:="Overwrite existing file?", Buttons:=vbYesNo)
If resp = vbNo Then
MsgBox "Try later with a different name"
End If
End If

If resp = vbYes Then
'stop the "are you sure you want to overwrite" message
Application.DisplayAlerts = False
'stop the _beforesave event from firing
Application.EnableEvents = False
On Error Resume Next
Me.SaveAs Filename:=UserFNameChoice, FileFormat:=xlWorkbookNormal
If Err.Number <> 0 Then
MsgBox "An error occurred:" & vbLf _
& Err.Number & vbLf & Err.Description _
& vbLf & vbLf & "FILE NOT SAVED!"
Err.Clear
Else
MsgBox "Saved as: " & vbLf & UserFNameChoice
End If
On Error GoTo 0
Application.EnableEvents = True
Application.DisplayAlerts = True
End If
End If
End Sub