Sub Testing()
Const sBackup As String = "C:\Backup\" '<=== change to suit
Dim sDir As String
Dim sFileFirst As String
Dim sFileDate As String
Dim sFilename As String

MsgBox "Select the start directory, " & vbNewLine & _
"then supply first part of file name, " & vbNewLine & _
"and finally the date suffix"

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
sDir = .SelectedItems(1)
End With

sDir = sDir & "\" & Format(Date, "mmmyy")
sFileFirst = InputBox("File prefix")
sFileDate = InputBox("File date suffix")

On Error Resume Next
MkDir sDir
On Error GoTo 0

sFilename = sFileFirst & Format(CDate(sFileDate), "yyyymmdd") & ".xls"
If Dir(sDir & "\" & sFilename) < "" Then
If MsgBox("Overwrite file?", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sDir & "\" & sFilename
Application.DisplayAlerts = True
ActiveWorkbook.SaveCopyAs sBackup & sFilename
End If
Else
ActiveWorkbook.SaveAs sDir & "\" & sFilename
ActiveWorkbook.SaveCopyAs sBackup & sFilename
End If

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Jim G" wrote in message
...
I have a need to save the current workbook as a defined name to a specific
location to avoid users overwriting my template.

Something in the order of:
1. Prompt to create a directory as the current month(Jul06,Aug06,Sept06
etc)
in a specified parent directory located on the server. If the directory
exists it uses it otherwise creates a new one (in other words, the first
user
of the month creates the directory)
2. Prompt for Username-1st part of the file name
3. Prompt for processing date-2nd part of the file name.
4. If the file name already exists, offer the option to overwrite.
4. Save the file to this location and a backup copy to another fixed
directory.

The action could be via a macro button or on close.

Cheers
Jim


--
Jim