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?
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
Can't seem to get it to work. Can anyone see the problem?
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