Routine that saves a file. If more than 7 in directory, deletes the oldest.

[wayliff]

I have a routine that saves files to the network and I'm trying to fin
a way to have the macro delete the oldest file if it reaches seven.


Function GetName(Dia As Date) As String
Dim AuxStr As String
AuxStr = Format(Dia, "dd-mmm-yyyy")
GetName = "TC Report - " & AuxStr & ".xls"
End Function

********************

Route = "C:\Data"
Dim Name As String
Dim I As Integer
If Right(Route, 1) <> "\" Then Route = Route & "\"
Name = GetName(Now())
If Dir(Route & Name) <> "" Then
I = 1
Name = Left(Name, Len(Name) - 4)
While Dir(Route & Name & " Version (0" & I & ")" & ".xls") <> ""
I = I + 1
Wend
Name = Name & " Version (0" & I & ")" & ".xls"
End If
ActiveWorkbook.SaveAs Filename:=Route & Name, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False, AccessMode:
_
xlShared
ActiveWindow.Close

This is how the macro currently works.
What I want it to do is delete the oldest file and save the ne
one...by looking at the same name and date or something to the effect
There are other files that I dont want it to even consider.

Can this be done?

Any kind of help or guidance appreciated

 

[Tom Ogilvy]

Possibly something like this. (assumes the files will be sequentially
numbered)


Dim Route as String, ii as Long
Dim bFound as Boolean
Dim sStr as String
dim list(1 to 99) as String
Route = "C:\Data"
Dim Name As String
Dim I As Longr
If Right(Route, 1) <> "\" Then Route = Route & "\"
Name = GetName(Now())
If Dir(Route & Name) <> "" Then
I = 1
Name = Left(Name, Len(Name) - 4)
Do
sStr = Dir(Route & Name & " Version (" & format(I,"00") & ")" & ".xls")
if sStr <> "" then
list(i) = sStr
if not bFound ii = i
bFound = true
elseif sStr = "" and bFound then
exit loop
end if
I = I + 1
Loop while i < 98
Name = Name & " Version (" & format(I+1,"00" & ")" & ".xls"
ActiveWorkbook.SaveAs Filename:=Route & Name, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False, AccessMode:=xlShared
if i >= 99 then
msgbox "Out of names"
end if
for k = ii to i - 6
kill Route & list(k)
Next
ActiveWindow.Close

 

[wayliff]

Thanks for your reply.

The files are in sequence but the numbers may not be one after th
other.
The name is given based on the date it is run.

I guess that should not be a problem for the solution.

Thanks again! I will review and give it a shot

 

[Don Guillett]

Something like this should work. Change mypath and mydate to suit. I left in
some commented items that show how it works.

Sub findoldestfile()
'Get number count
MyPath = "c:\aa\"
With Application.FileSearch
.NewSearch
.LookIn = MyPath
.Filename = "*.xls"
.Execute
filecount = .FoundFiles.Count
End With
If filecount >= 5 Then

Dim mFile As String
mydate = "12/27/2005"
mFile = Dir(MyPath & "*.xls")

Do While mFile <> ""

'mydate = FileDateTime("C:\aa\" & mFile)
If FileDateTime(MyPath & mFile) < mydate Then
'mydate = FileDateTime("C:\aa\" & mFile)
myname = (MyPath & mFile)
End If

mFile = Dir()

Loop
'MsgBox mydate
MsgBox myname
'Kill myname
End If

End Sub