Logo 
Search:

MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

using todays date as file name

  Asked By: Jody    Date: Oct 21    Category: MS Office    Views: 760
  

I have tried several differnet ways to take the current date and as a
file with that date ie.... 062708.xls

Following is my last attempt... Can someone please guide me to the
correct code I would use here. Thanks.

ActiveWorkbook.SaveAs Filename:="C:\" & Format(Now(), mmddyy) & ".xls"

Share: 

 

5 Answers Found

 
Answer #1    Answered By: Damian Jones     Answered On: Oct 21

Not too sure but have you tried it without the () , i.e. ActiveWorkbook.SaveAs
Filename:="C:\" & Format(Now, mmddyy) & ".xls"
It is just a thought because part of one of my vba run sheets creates a filename
for the saved workbook from various cells but then also includes the date  and
time in the filename and my bit of code does not have the () after now

 
Answer #2    Answered By: Eamon Jones     Answered On: Oct 21

just tried, that don't seem to work but if you play around a little with
the following I'm sure it will do what you want or at least get you on the right
lines

Sub Save()

Dim strFilename
strFilename = Application.GetSaveAsFilename("My File" & Format(Now,
"ddmmyyhhnnss") & _
".xls", "Microsoft Excel 97-2000 & 5.0/95 Workbook
(*.xls),*.xls")

If strFilename <> "False" Then
ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:= _
xlExcel9795, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
End If
Exit Sub

End Sub

 
Answer #3    Answered By: Rachael Ferguson     Answered On: Oct 21

just tried, that don't seem to work but if you play around a little with
the following I'm sure it will do what you want or at least get you on the right
lines

Sub Save()

Dim strFilename
strFilename = Application.GetSaveAsFilename("My File" & Format(Now,
"ddmmyyhhnnss") & _
".xls", "Microsoft Excel 97-2000 & 5.0/95 Workbook
(*.xls),*.xls")

If strFilename <> "False" Then
ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:= _
xlExcel9795, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
End If
Exit Sub

End Sub

 
Answer #4    Answered By: Muhammad Evans     Answered On: Oct 21

I've been trying to ignore email these last few weeks because my tact and my
interest have both evaporated. So if I provide offense in my reply, please
know it's a personal limitation and nothing personal beyond that.

I think I'd take a slightly different approach on this. Get your filename
created in a separate function. The function should do nothing more than:
- create the date  based file  name (this way you can introduce other
functions to easily allow you to change paths if you'd like)
- If a month, day or second value is less than 2 characters, add a leading
zero

Here are the basics.
'============================================================
Function GetDateBasedFileName()

Dim strYear As String
Dim strMonth As String
Dim strDay As String
Dim strVer As String

strYear = Year(Now)
strMonth = Pad(Month(Now))
strDay = Pad(Day(Now))
strVer = Pad(Second(Now))

GetDateBasedFileName = strMonth & strDay & strYear & strVer

End Function
'============================================================
Function Pad(strToPad)

If Len(strToPad) < 2 Then
Pad = "0" & strToPad
Else
Pad = strToPad
End If

End Function
'============================================================

You can test this with the Immediate Window open in your VBE and running
this test macro:
Sub Main()
Debug.Print GetDateBasedFileName
End Sub

So your date creation formula below would now look like this:
ActiveWorkbook.SaveAs Filename:="C:\" & GetDateBasedFileName & ".xls"

You could also create other functions to ensure you have write permissions
to that path but that's another topic. Just know that the newer security
features of Vista are going to give you some challenges about writing to
some directories including the drive root.

 
Answer #5    Answered By: Haru Tanaka     Answered On: Oct 21

This is sloppy in that I violated my own rules for maintaining operational
clarity between subroutines and functions and I did get away from using
sterile variable naming but it will do an automatic file  save and avoid
conflicts with existing files. It covers what I think you were after when
you state you desire a Counter. It's viral in its operation so be careful:
'============================================================

Sub GetTheName()

For i = 0 To 10
Debug.Print GetDateBasedFileName
ActiveWorkbook.SaveAs Filename:=GetDateBasedFileName
Next i

End Sub

'============================================================
Function GetDateBasedFileName()

Dim strYear As String
Dim strMonth As String
Dim strDay As String
Dim strVer As String
Dim strHour As String
Dim strMinute As String
Dim intCounter As Integer
Dim strDrive As String
Dim boolX As Boolean

strDrive = "C:\vbscripts\"
strYear = Year(Now)
strMonth = Pad(Month(Now))
strDay = Pad(Day(Now))
strHour = Pad(Hour(Now))
strMinute = Pad(Minute(Now))
strVer = Pad(Second(Now))

On Error Resume Next
intCounter = 0
boolX = True

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Err <> 0 Then
Err.Clear
End If
GetDateBasedFileName = strDrive & strMonth & strDay & strYear & strHour
& strMinute & strVer & FilePad(intCounter) & ".xls"
Do Until boolX = False
If fso.FileExists(GetDateBasedFileName) Then
intCounter = intCounter + 1
GetDateBasedFileName = strDrive & strMonth & strDay & strYear &
strHour & strMinute & strVer & FilePad(intCounter) & ".xls"
Else
boolX = False
End If
Loop

Set fso = Nothing

End Function
'============================================================
Function Pad(strToPad)

If Len(strToPad) < 2 Then
Pad = "0" & strToPad
Else
Pad = strToPad
End If

End Function
'============================================================
Function FilePad(intRefCount As Integer) As String

Dim intLen

intLen = Len(intRefCount)

Select Case intLen
Case 2
FilePad = "00" & CStr(intRefCount)
Case 3
FilePad = "0" & CStr(intRefCount)
Case 4
FilePad = CStr(intRefCount)
Case Else
End Select

End Function

'============================================================

 
Didn't find what you were looking for? Find more on using todays date as file name Or get search suggestion and latest updates.




Tagged: