Home » Blogs » Vishesh's blog

Date Stamped Report File

Vishesh's picture
Submitted by Vishesh on 24 May, 2012 - 17:22
Simple utility to save the file with current date stamped in the file name. Specify the file name in the range provided for it.

Download the attached file and see how it works.

This the code working behind the scenes... 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
 Cancel As Boolean)
    If Range("rReport").Value = "" Then
        Cancel = True
        Exit Sub
    End If
    Application.EnableEvents = False
    Cancel = True
    On Error Resume Next
        Kill ThisWorkbook.Path & Application.PathSeparator _
         & Format(Date, "yyyymmdd") & "_" & Range("rReport").Value _
         & "." & Split(ThisWorkbook.Name, ".")(1)
    On Error GoTo 0: Err.Clear: On Error GoTo -1
 
    ThisWorkbook.SaveAs ThisWorkbook.Path &  _
      Application.PathSeparator & Format(Date, "yyyymmdd") & "_" _
      & Range("rReport").Value, ThisWorkbook.FileFormat
    ThisWorkbook.Saved = True
    DoEvents
    Application.EnableEvents = True
End Sub
AttachmentSize
SaveReport.xls33 KB
»
Vishesh's picture

Above piece of code saves the

Submitted by Vishesh on 26 May, 2012 - 18:01.

Above piece of code saves the same file that you are working with while the following piece of code creates a new file (blank workbook) and save it.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wbkNew As Workbook
Dim strRptName As String

strRptName = ThisWorkbook.Names("rReport").RefersToRange.Value

If Trim(strRptName) = "" Then
MsgBox "Please provide the report name..."
Application.Goto ThisWorkbook.Names("rReport").RefersToRange
Exit Sub
End If

On Error Resume Next
Kill ThisWorkbook.Path & Application.PathSeparator _
& Format(Date, "yyyymmdd") & "_" & strRptName _
& "." & Split(ThisWorkbook.Name, ".")(1)
If Err.Number = 70 Then
MsgBox "Unable to delete file '" & ThisWorkbook.Path & Application.PathSeparator _
& Format(Date, "yyyymmdd") & "_" & strRptName _
& "." & Split(ThisWorkbook.Name, ".")(1) & "'", vbOKOnly
Err.Clear: On Error GoTo 0
Exit Sub
End If
On Error GoTo 0: Err.Clear: On Error GoTo -1

Set wbkNew = Application.Workbooks.Add

wbkNew.SaveAs ThisWorkbook.Path & _
Application.PathSeparator & Format(Date, "yyyymmdd") & "_" _
& strRptName, ThisWorkbook.FileFormat

Set wbkNew = Nothing
End Sub

»