Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Jody Mills   on Oct 21 In MS Office Category.

  
Question Answered By: Haru Tanaka   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

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

Share: 

 

This Question has 4 more answer(s). View Complete Question Thread

 
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: