VBA Adding a date and time to file name

[Sheila Yau]

Hi,

I have used a macro from the book "Office VBA Macros you can use today" E002.xls which save a file with a date name. I have amended this so that I can include the time in the file name too. However, when it saves the file it is not an excel file as time is hh.mm format.

The VBA is below - does anyone know how I can fix this?

Thanks,

Sheila

Option Explicit

Sub SaveWorkbookAsToday()
'This macro will save the current (active) workbook _
with today's date

Dim DateFormat As String 'The format that will be used
'for the filename
Dim TimeFormat As String 'The format that will be used
'for the filename
Dim Path As String 'The path that will be used, if its
'empty, the macro will use the
'current directory
Dim Append As String 'A text that will be appended to
'the filename, with the date
'**********
'Change the following variables

'Do not use "\" or "/" as the date separator
DateFormat = "dd-mm-yyyy "
DateFormat = Range("T1").Value

'Do not use "\" or "/" as the time separator
TimeFormat = "hh.mm"
TimeFormat = Range("T2").Value


Path = ""
'Path = "C:\My Documents"
Path = Range("T3").Value

Append = ""
'Append = "Report "
Append = Range("T4").Value
'**********

'Make sure we have a valid date format
If DateFormat Like "[\/]" Then
MsgBox "Illegal date format used", vbCritical
Else
'Assign today's date
DateFormat = Format$(Date, DateFormat)

'Make sure we have a valid time format
If TimeFormat Like "[\/]" Then
MsgBox "Illegal time format used", vbCritical
Else
'Assign today's time
TimeFormat = Format$(Time, TimeFormat)

'Add a text to the filename ?
DateFormat = Append & DateFormat & TimeFormat

'Is there a path assigned ?
If Len(Path) = 0 Then
'Use the current directory
Path = CurDir()
End If

'Create the full name for the file

'Make sure that there's a folder separator at the end
If Right$(Path, Len(Application.PathSeparator)) <> _
Application.PathSeparator Then
Path = Path & Application.PathSeparator
End If

'Append the date
Path = Path & DateFormat

'Try to save the active workbook with that name
On Error Resume Next
ActiveWorkbook.SaveAs Path

'See if we got an error
If Err.Number <> 0 Then
MsgBox "The following error occured:" & vbNewLine & _
"Error: " & Err.Number & ", " & Err.Description, vbCritical
End If
End If
End If
End Sub

 

[Airfix9]

Hi Sheila, welcome to the board.

Have you added ".xls" to the end of the save string?

 

[Sheila Yau]

Thanks for your help.
I'm just starting out with VBA.

How would I add .xls to the text string?

I've tried this

DateFormat = Append & DateFormat & TimeFormat & ".xls"

and


DateFormat = Append & DateFormat & TimeFormat & .xls

but neither work

 

[Airfix9]

Hi Sheila,

Sorted it (and cut it down a bit...)

Option Explicit



Sub SaveWorkbookAsToday()
'This macro will save the current (active) workbook _
with today's date

' This sets up the three variables

Dim DateFormat, TimeFormat, Path, append As String

'**********
'Change the following variables

' reformat date cell for acceptable style
DateFormat = Application.WorksheetFunction.Text(Range("T1").Value, "dd-mm-yy")

' reformat time cell for acceptable style
TimeFormat = Application.WorksheetFunction.Text(Range("T2").Value, "hh.mm")




'NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB'
'                              you could use                               '
'DateFormat = Application.WorksheetFunction.Text(Now(), "dd-mm-yy hh.mm")  '
'                    for the whole date and time thing                     '
'NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB'




' Check that a path exists

If Range("T3").Value = "" Then
Path = CurDir()
Else: Path = Range("T3").Value
End If

' Gets file name

append = Range("T4").Value

'**********

' Create the full filename (excl Path)

DateFormat = append & " " & DateFormat & " " & TimeFormat & ".xls"

'Create the full name for the file

'Make sure that there's a folder separator at the end
If Right$(Path, Len(Application.PathSeparator)) <> _
Application.PathSeparator Then
Path = Path & Application.PathSeparator
End If

'Append the date
Path = Path & DateFormat

'Try to save the active workbook with that name
On Error Resume Next
ActiveWorkbook.SaveAs Path

'See if we got an error
If Err.Number <> 0 Then
MsgBox "The following error occured:" & vbNewLine & _
"Error: " & Err.Number & ", " & Err.Description, vbCritical
End If


End Sub

 

[Sheila Yau]

It has worked

Thank you very much!