GetSaveAsFileName questions

[Stuart]

I'm taking User's data from a Form and copying it into a
copy of a sheet from the Addin which displays the form.

User clicks 'Save' button on the form, and the following
code runs:

Private Sub CbSave_Click()
Dim ws As Worksheet, wkbkname As String
Dim newbookname As String, sFileName As Variant
Application.ScreenUpdating = False
wkbkname = "G&H Project.xla"
With Workbooks
.Add (xlWBATWorksheet)
newbookname = ActiveWorkbook.Name
Workbooks(wkbkname).Sheets("Fax Template") _
.Copy Before:=ActiveWorkbook.Sheets(1)
Application.DisplayAlerts = False
For Each ws In Workbooks(newbookname) _
.Worksheets
With ws
If .Name <> "Fax Template" Then
.Delete
End If
End With
Next
Application.DisplayAlerts = True
ActiveWorkbook.Unprotect Password:= "abc"
ActiveSheet.Unprotect Password:="abc"
End With

With Workbooks(newbookname). _
Worksheets("Fax Template")

'code to copy data from form into new sheet

'then code to effect the Save
sFileName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If sFileName <> False Then
Workbooks(newbookname).SaveAs _
Filename:=sFileName
ActiveWorkbook.Close SaveChanges:=True
Else
ActiveWorkbook.Close SaveChanges:=False
End If

I would like to amend this code to incorporate as follows:

1. Point the Save to "C:\Temp"
2. Ensure a valid filename (*.xls) and, which must not be
newbookname
3. Let user quit the Save, and ensure the sheet is killed
and user returned to the Form

Can this be achieved, please?

Regards.

 

[Dave Peterson]

If I knew where I had to save the file, I think I'd just ask for a filename, try
saving the file and see if it was successful. You can't save another file with
the same name as an open workbook (so that shouldn't be a separate problem).

This may give you an idea that you can use:

Option Explicit
Sub testme()

Dim sFileName As String
Dim myErrNumber As Long
Dim NewBook As Workbook

Set NewBook = Workbooks.Add

Do
sFileName = InputBox(Prompt:="Enter a filename", default:="howdy")

If LCase(Right(sFileName, 4)) <> ".xls" Then
sFileName = sFileName & ".xls"
End If

sFileName = "C:\temp\" & sFileName

On Error Resume Next
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=sFileName
myErrNumber = Err.Number
Application.DisplayAlerts = True
On Error GoTo 0
Err.Clear

If myErrNumber = 0 Then
'save was ok
'exit the do loop
Exit Do
Else
MsgBox "Please enter a valid filename"
End If
Loop

NewBook.Close savechanges:=False

End Sub

The user won't be able to dismiss that prompt and exit the routine--you may want
to allow that behavior.

 

[Stuart]

Many thanks for the example.

Regards.

If I knew where I had to save the file, I think I'd just ask for a
filename, try
saving the file and see if it was successful. You can't save another file
with
the same name as an open workbook (so that shouldn't be a separate
problem).

This may give you an idea that you can use:

Option Explicit
Sub testme()

Dim sFileName As String
Dim myErrNumber As Long
Dim NewBook As Workbook

Set NewBook = Workbooks.Add

Do
sFileName = InputBox(Prompt:="Enter a filename", default:="howdy")

If LCase(Right(sFileName, 4)) <> ".xls" Then
sFileName = sFileName & ".xls"
End If

sFileName = "C:\temp\" & sFileName

On Error Resume Next
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=sFileName
myErrNumber = Err.Number
Application.DisplayAlerts = True
On Error GoTo 0
Err.Clear

If myErrNumber = 0 Then
'save was ok
'exit the do loop
Exit Do
Else
MsgBox "Please enter a valid filename"
End If
Loop

NewBook.Close savechanges:=False

End Sub

The user won't be able to dismiss that prompt and exit the routine--you
may want
to allow that behavior.