VB Code. Need help

WHYME

New Member
Joined
Jan 12, 2005
Messages
10
The programme i am working on creates report files with timestamps, thats works. I have tried to create code that limits the number of reports files created in that directory. The below code is designed to limit the number of files created, when that limit is reached is will over write the oldest file.

Can't seem to get it to work. Can anyone see the problem?

:oops:

Sub PerformFileAdmin(p_FileName As String)
'Declarations
Dim myFile As String
Dim theDateTime As String
Dim earliestFile As String
Dim i As Long
Dim j As Long
Dim earliestindex As Long
ReDim DateFileNameArray(0) 'Create One Array Item

'Error handling.
On Error GoTo erh

If sheetReportOptions.GetMaxNumberOfFiles() > 0 Then
myFile = Dir(ThisWorkbook.Path & "\*.xls")
Do While myFile <> "" ' Keep Going Until No more Files.
'Get The Date Part Of The Filename
theDateTime = GetReportDateTime(p_FileName, myFile, FILEDATEFORMAT)
'Need To Discard The Actual Report Configuration File
If IsNumeric(theDateTime) Then
'Found A New File So Add It To The Array If New
AddNewFileToArray theDateTime
End If
' Call Dir again without arguments to return the next report files in the
' same directory.
myFile = Dir
Loop

If UBound(DateFileNameArray) + 1 > sheetReportOptions.GetMaxNumberOfFiles() Then
'Perfom Simple Selective Sort On The Array
'No Need To Check The Last Entry It Must Be In Order
For i = 0 To UBound(DateFileNameArray) - 1 Step 1
'Set earliestFile For Comparison
earliestFile = DateFileNameArray(i)
earliestindex = 0
'Loop Thru The Unsorted Part Of The Array To Find Earliest File
For j = i To UBound(DateFileNameArray) - 1 Step 1
If earliestFile > DateFileNameArray(j + 1) Then
'Earlier File Found So Set earliestFile And Its Index
earliestFile = DateFileNameArray(j + 1)
earliestindex = j + 1
End If
Next j
'If earliestindex Is > 0 Then Array Items Need Swopping
If earliestindex > 0 Then
DateFileNameArray(earliestindex) = DateFileNameArray(i)
DateFileNameArray(i) = earliestFile
End If
Next i
'Loop Thru All Extra Files And Remove Them
For i = 0 To UBound(DateFileNameArray) - sheetReportOptions.GetMaxNumberOfFiles()
'Delete It
Kill (ThisWorkbook.Path & "\" & p_FileName & DateFileNameArray(i) & ".xls")
Next i
End If
End If
Exit Sub

erh:
AppShowError "Perform File Admin", "AutoSaveModule"
Exit Sub
End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Forum statistics

Threads
1,214,911
Messages
6,122,198
Members
449,072
Latest member
DW Draft

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top