Below is the code that brings up the SAVE as prompt, and want to save to a
default
location, I thought i had the correct code to automatically insert a cell
reference and the current date in the file name and also save in default
location. Can you assist please?

Dim flName As String
Dim flFormat As Long
Dim Response As String
Dim msg As String
Dim Style As String
Dim sFilename As String
Dim ans

msg = "Are you sure you want to save the Smith quote?"
Style = vbYesNo + vbInformation + vbDefaultButton2

Response = MsgBox(msg, Style)
If Response = vbYes Then

flFormat = ActiveWorkbook.FileFormat

DefaultFolder = "M:\Contract\Current\Nationwide\Templates\Proj ect
Brief&SOR\Project Briefs to be Approved prior to sending inc master SOR
Project brief\"
If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If

DefaultFilename = Range("C1")

If Right(UCase(DefaultFilename), 2) < "XLS" Then
DefaultFilename = DefaultFilename & Format(Date, "ddmmyyyy") & ".xls"
DefaultFilename = DefaultFilename & ".xls"
End If

flToSave = Application.GetSaveAsFilename(flName, filefilter:="Excel
Files (*.xls),*.xls", _
Title:="Save File As...")


If flToSave = False Then

Exit Sub

Else

ThisWorkbook.SaveAs Filename:=flToSave, FileFormat:=flFormat


End If

Hi Neil

The code below is one way of doing it, if you pass the default folder
along with the filename in the GetSaveAsFileName it will load your
default directory, and if there is an error it will load the default
directory for office. I created the folder C:\Test just for testing
the code you can replace this with your own Directory.

Sub SaveAsWithDefaults()

Dim Response As String
Dim DefaultFolder As String, DefaultFileName As String
Dim FileToSave

Response = MsgBox("Are you sure you want to save the Smith
quote?", _
vbYesNo + vbInformation + vbDefaultButton2)

If Response = vbYes Then
DefaultFolder = "C:\Test"
If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If
DefaultFileName = Range("C1")
If Right(UCase(DefaultFileName), 3) < "XLS" Then
DefaultFileName = DefaultFileName & " " & _
Format(Date, "dd-mm-yyyy") & ".xls"
End If
FileToSave = Application.GetSaveAsFilename _
(DefaultFolder & DefaultFileName, filefilter:="Excel Files
(*.xls)," _
& "*.xls", Title:="Save File As...")
If FileToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:=FileToSave, _
FileFormat:=ActiveWorkbook.FileFormat
End If
End If

End Sub

I hope this helps you out

Steve

Sub xxx()

Dim flName As String
Dim flFormat As Long
Dim Response As String
Dim msg As String
Dim Style As String
Dim sFilename As String
Dim ans

msg = "Are you sure you want to save the Smith quote?"
Style = vbYesNo + vbInformation + vbDefaultButton2

Response = MsgBox(msg, Style)
If Response = vbYes Then

flFormat = ActiveWorkbook.FileFormat

DefaultFolder = "c:\temp\"


DefaultFilename = Range("C1")

If Right(UCase(DefaultFilename), 3) < "XLS" Then
DefaultFilename = DefaultFilename & Format(Date, "ddmmyyyy") &
".xls"
DefaultFilename = DefaultFilename & ".xls"
End If

flToSave = Application.GetSaveAsFilename(flName, filefilter:="Excel
Files (*.xls),*.xls", _
Title:="Save File As...")


If flToSave = False Then

flToSave = DefaultFolder & DefaultFilename

End If
ThisWorkbook.SaveAs Filename:=flToSave, FileFormat:=flFormat



End If
End Sub

"Neil Holden" wrote:

Below is the code that brings up the SAVE as prompt, and want to save to a
default
location, I thought i had the correct code to automatically insert a cell
reference and the current date in the file name and also save in default
location. Can you assist please?

Dim flName As String
Dim flFormat As Long
Dim Response As String
Dim msg As String
Dim Style As String
Dim sFilename As String
Dim ans

msg = "Are you sure you want to save the Smith quote?"
Style = vbYesNo + vbInformation + vbDefaultButton2

Response = MsgBox(msg, Style)
If Response = vbYes Then

flFormat = ActiveWorkbook.FileFormat

DefaultFolder = "M:\Contract\Current\Nationwide\Templates\Proj ect
Brief&SOR\Project Briefs to be Approved prior to sending inc master SOR
Project brief\"
If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If

DefaultFilename = Range("C1")

If Right(UCase(DefaultFilename), 2) < "XLS" Then
DefaultFilename = DefaultFilename & Format(Date, "ddmmyyyy") & ".xls"
DefaultFilename = DefaultFilename & ".xls"
End If

flToSave = Application.GetSaveAsFilename(flName, filefilter:="Excel
Files (*.xls),*.xls", _
Title:="Save File As...")


If flToSave = False Then

Exit Sub

Else

ThisWorkbook.SaveAs Filename:=flToSave, FileFormat:=flFormat


End If

Well a genius!!! THANKYOU!!!!!!

"Incidental" wrote:

Hi Neil

The code below is one way of doing it, if you pass the default folder
along with the filename in the GetSaveAsFileName it will load your
default directory, and if there is an error it will load the default
directory for office. I created the folder C:\Test just for testing
the code you can replace this with your own Directory.

Sub SaveAsWithDefaults()

Dim Response As String
Dim DefaultFolder As String, DefaultFileName As String
Dim FileToSave

Response = MsgBox("Are you sure you want to save the Smith
quote?", _
vbYesNo + vbInformation + vbDefaultButton2)

If Response = vbYes Then
DefaultFolder = "C:\Test"
If Right(DefaultFolder, 1) < "\" Then
DefaultFolder = DefaultFolder & "\"
End If
DefaultFileName = Range("C1")
If Right(UCase(DefaultFileName), 3) < "XLS" Then
DefaultFileName = DefaultFileName & " " & _
Format(Date, "dd-mm-yyyy") & ".xls"
End If
FileToSave = Application.GetSaveAsFilename _
(DefaultFolder & DefaultFileName, filefilter:="Excel Files
(*.xls)," _
& "*.xls", Title:="Save File As...")
If FileToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:=FileToSave, _
FileFormat:=ActiveWorkbook.FileFormat
End If
End If

End Sub

I hope this helps you out

Steve