Sure can Jim.

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
Dim dteFile As Date
Dim fExitDo As Boolean

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")
fExitDo = False
Do
sFileDate = InputBox("File date suffix (in the form 25/10/2006)")
On Error Resume Next
dteFile = CDate(sFileDate)
On Error GoTo 0
If sFileDate = "" Then
fExitDo = True
ElseIf dteFile < 0 Then
fExitDo = True
Else
MsgBox "Invalid date, please re-submit"
End If
Loop Until dteFile < 0 Or sFileDate = ""

If sFileDate = "" Then Exit Sub

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
...
Works great Bob thanks,

I added an example to the input box message "eg; 25/10/06" to esure a full
date.

Is there a way to trap the error and remind the user to use the correct
format?
--
Jim


"Bob Phillips" wrote:

My code assumed a full date and worked out the format. I think that is
safer
rather than expecting users to get the format right.



--
HTH

Bob Phillips

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

"Jim G" wrote in message
...
Thanks Bob,

I ran the code and was presented with the Bowser to select the
directory
(I
created a C:\Backup to test). I'll need to instruct users to select
this
parent directory.

I then was asked for file prefix, which I supplied, and a date prefix
where
I entered Oct06. Error 13 occured indcating a 'type mismatch' and
highlighted line - sFilename = sFileFirst & Format(CDate(sFileDate),
"yyyymmdd") & ".xls"

The Subdirectory Oct06 was created. I re-ran the code to the error
point
and entered Oct06 again and it did not duplicate the directory as
required.

Any ideas on the stop error?

Cheers
Jim

--
Jim


"Bob Phillips" wrote:

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