View Single Post
  #19   Report Post  
Posted to microsoft.public.excel.misc
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default New TimeStampFile routine also does new unsaved files

Okay.., I managed to get things tweaked so that the TimeStampFile
routine will also handle new unsaved files. The previously posted
'Test_' routine has been revised accordingly.

I invite any feedback...

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.
' If Wkb is a new unsaved workbook then next 2 args
must be valid.
'
' SavePath Allows specifying a new path;
' If not specified Wkb.Path is used.
' Req'd if Wkb is a new unsaved workbook.
'
' Filename Allows renaming root filename;
' If not specified Wkb.Name is used.
' Req'd if Wkb is a new unsaved workbook.
'
' AddNameStamp True to put username between filename and timestamp;
' Default = False.
'
' SaveAsCopy True saves a copy of Wkb; (Default)
' 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

If SavePath < "" Then
If Right(SavePath, 1) < "\" Then SavePath = SavePath & "\"
End If 'SavePath < ""

'Make sure we have a file extension
vFileInfo = Split(Wkb.FullName, ".")
'If no file ext then it's an unsaved file,
'and so has no path yet.
If LBound(vFileInfo) = UBound(vFileInfo) Then
If SavePath < "" And Filename < "" Then
'Use the new file info
vFileInfo = Split(Filename, ".")
vFileInfo(0) = SavePath & vFileInfo(0)
vFileInfo(1) = "." & vFileInfo(1) '//restore dot to file ext.
sFile = vFileInfo(0): GoTo StampIt
Else '//abort
Beep
Exit Sub
End If
End If 'LBound=UBound

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

If SavePath < "" Then sFile = SavePath & Split(Wkb.Name, ".")(0)
If Filename < "" Then sFile = Replace(sFile, Split(Wkb.Name,
".")(0), Filename)

StampIt:
'Separate name from stamps so filename is easy to read
vFileInfo(0) = sFile & "_"
If AddNameStamp Then vFileInfo(0) = vFileInfo(0) &
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

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\Garry\Documents\VBA_Stuff"

'To save a copy of ActiveWorkbook to a different path,
'with a different filename.
'Note: This is the minimum requirement for a new unsaved workbook
TimeStampFile SavePath:="C:\Users\Garry\Documents\VBA_Stuff", _
Filename:="MyFile.xls"

'To save a copy of ActiveWorkbook to a different path,
'with a namestamp.
TimeStampFile SavePath:="C:\Users\Garry\Documents\VBA_Stuff", _
AddNameStamp:=True

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

--
Garry

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