Code to save spreadsheet

[FrigidDigit]

Hi Everyone!

I have a spreadsheet for which I have used code (see below) to determine a
filename to be used when saving the template based on certain cell values.
I have added code to check whether the user has changed the save as name
which appears in the dialog box. All works fine except if the user wants to
save the file in a folder other than the one in which the template resides
in. How can I allow the user to change the directory in which to save
without changing the filename?

Any help is much appreciated!

Regards

Lawrence.



Public Sub SaveInvoice()
Dim SaveName As String
Dim SaveDir As String
Dim SaveMonthStart As String
Dim SaveMonthEnd As String
Dim SaveYearStart As String
Dim SaveYearEnd As String
Dim FixedInvNum As String

SaveMonthStart = Worksheets("Billing Rates").Range("AE11").Value
SaveMonthEnd = Worksheets("Billing Rates").Range("AF11").Value
SaveYearStart = Worksheets("Billing Rates").Range("AG11").Value
SaveYearEnd = Worksheets("Billing Rates").Range("AH11").Value

Application.ScreenUpdating = False
VerifyInvoice
Application.ScreenUpdating = True
If Worksheets("Inv Summ").Range("I12").Value < 10 Then
FixedInvNum = "0" & Worksheets("Inv Summ").Range("I12").Value
Else: FixedInvNum = Worksheets("Inv Summ").Range("I12").Value
End If

If SaveYearStart = SaveYearEnd And SaveMonthStart = SaveMonthEnd Then
SaveName = Worksheets("Billing Rates").Range("AB11").Value & " - IEP
Inv#" & FixedInvNum & _
" TO" & Range("I11").Value & " " & SaveMonthEnd & " " & SaveYearEnd &
".xls"
Else
SaveName = Worksheets("Billing Rates").Range("AB11").Value & " - IEP
Inv#" & FixedInvNum _
& " TO" & Range("I11").Value & " " & SaveMonthStart & " " &
SaveYearStart & " - " & _
SaveMonthEnd & " " & SaveYearEnd & ".xls"

End If
SaveName = ActiveWorkbook.Path & "\" & SaveName
Restart:
filesavename = Application.GetSaveAsFilename( _
InitialFileName:=SaveName, fileFilter:="Excel Files (*.xls), *.xls")

If filesavename = False Then
Exit Sub
ElseIf filesavename <> SaveName Then
MsgBox "Please do not change the generated file name when saving."
MsgBox "Filesavename = " & filesavename & Chr(13) & "SaveName = " &
SaveName
'MsgBox ActiveWorkbook.Path
GoTo Restart
End If
ActiveWorkbook.SaveAs Filename:=filesavename
End Sub

 

[ben]

look up in help the filedialogs method and see "FolderPicker" dialog
will allow user to choose a folder you can reference but not to change names

 

[Tom Ogilvy]

If you only want to allow the user to pick a folder, then put up the folder
select dialog.

http://j-walk.com/ss/excel/tips/tip29.htm
at John Walkenbach's site

 

[STEVE BELL]

Here's some code I picked up from this ng (works in Excel 2000)
Opens the Save-As dialog.
Amend it to fit your needs...

Sub ShowSaveAsDialog()
Dim v_Filename As Variant
'Variant because the dialog will
'return False if cancelled.

'The Len expression gets rid of the .txt extension.

v_Filename = Application.GetSaveAsFilename _
(initialfilename:=Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4), _
fileFilter:="Microsoft Excel Workbook (*.xls), *.xls")

If v_Filename = False Then Exit Sub

ActiveWorkbook.SaveAs v_Filename, xlWorkbookNormal

End Sub

 

[FrigidDigit]

Appreciate the help!