Insert a new line as follows...

Sub TimeStampFile(Optional Wkb As Workbook, Optional SavePath$, _
Optional Filename$, Optional AddNameStamp As
Boolean, _
Optional SaveAsCopy As Boolean = True)
' Puts a date/time stamp on Wkb filename.
' Formats timestamp appropriate for use in filenames.
'
' ArgsIn:
' Wkb Ref to the workbook having its filename
timestamped;
' If not specified then ref defaults to
ActiveWorkbook.
' SavePath Allows specifying a new path;
' If not specified Wkb.Path is used.
' Filename Allows renaming root filename;
' If not specified Wkb.Name is used.
' AddNameStamp True to put username between filename and
timestamp;
' Default = False.
' SaveAsCopy Saves a copy of Wkb;
' Default=True;
' Note: This DOES NOT alter the original file.
' False saves Wkb as specified in 'SavePath' and/or
'Filename';
' Note: This DOES alter the original file.

Dim sFile$, sNameStamp$, vFileInfo

'Get a fully qualified ref to the workbook
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook

'Parse the file extension
vFileInfo = Split(Wkb.FullName, ".")
If Not IsArray(vFileInfo) Then Beep: Exit Sub '//unsaved file

vFileInfo(1) = "." & vFileInfo(1) '//restore dot to file ext.
sFile = vFileInfo(0)

If SavePath < "" Then
If Right(SavePath, 1) < "\" Then SavePath = SavePath & "\"
sFile = SavePath & Split(Wkb.Name, ".")(0)
End If 'SavePath < ""

If Filename < "" Then sFile = Replace(sFile, Split(Wkb.Name,
".")(0), Filename)
'Separate name from stamps so filename is easy to read
sFile = sFile & "_"

If AddNameStamp Then vFileInfo(0) = sFile & Environ("username") &
"_"
'Separate timestamp parts so they're easy to read
sFile = Join(vFileInfo, Format(Now(), "dd-mm-yyyy_hh-mm_AMPM"))

'Creat the new file
If SaveAsCopy Then Wkb.SaveCopyAs sFile Else Wkb.SaveAs sFile
End Sub

..which is reusable in the following fashion...

Sub Test_TimeStampFile()
'To save a copy of ActiveWorkbook to its .Path
TimeStampFile

'To save a copy of ActiveWorkbook to a different path
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\"

'To save a copy of ActiveWorkbook to a different path,
'with a different root filename.
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\",
Filename:="NewName"

'To save a copy of ActiveWorkbook to a different path,
'with a namestamp.
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\",
AddNameStamp:=True

'To do same for a specified 'open' Workbook, add:
TimeStampFile Wkb:=ThisWorkbook
'Or
TimeStampFile Wkb:=Workbooks("MyFile.xls")
End Sub

This will handle your file save issues every which way you need it
done. It even saves to network locations if you specify a UNC path
(ie: "\\Server\Share")

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion