Re: User defined file name on save

Bob, you’re a legend!

This is powerful stuff. I’m having quite bit of fun changing the bits I
understand.

One issue I have is with the creation of the default directory.

My users often continue to populate the template after the end of the month
the transaction relates to (It’s a credit card expense form that is imported
to the accounts). They have a choice of progressively entering expenses
through the month or complete all at once at the end. You can guess the
popular option.

When the code runs in the same month it creates a Dir once for that month
and saves that and subsequent files to the same Dir and a back-up in the
parent Dir. If a file has the same name it asks to overwrite as an alert.
This is all good. However, when the month rolls over, the working file from
the old month is saved into the Dir created for the new month. Is there a
solution to this or would it be simpler to have the user create the new
period Dir in the first instance, and then simply choose the location on
subsequent saves?

Is there a way to have the saved copy save in a location other than the
parent directory? I’m considering a location that the users would not be
aware of.

Thanks again Bob, I’ve learned a lot from this.

--
Jim


"Bob Phillips" wrote:

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" <JimG@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:3B2A4D81-2450-4143-A4F3-18D260BC084D@xxxxxxxxxxxxxxxx
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" <JimG@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:8C754558-6D4C-4832-933B-E5A19899E5F8@xxxxxxxxxxxxxxxx
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" <JimG@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:E1209977-76B9-418C-AAAC-8E100502CC56@xxxxxxxxxxxxxxxx
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









.