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
'============================================================