Advice about error handling function

[John J.]

I've written the function below which deletes backupfiles (of which the name
starts with yearmonthday) older than 30 days in a specified folder. Though
it works, I'm not sure about the err_handler. The handler takes care of the
situation where Cdate() doesn't give a valid date and types don't match.

I would be happy if someone could give me advice if and how this could be
done better.
Thank you,
John

Function delBU(strBUfolder As String)
Dim strTemp As String
Dim d As Date

On Error GoTo Err_Handler

strTemp = Dir(strBUfolder)
Do While strTemp <> vbNullString
d = CDate(Mid(strTemp, 5, 2) & "/" & Mid(strTemp, 7, 2) & "/" &
Left(strTemp, 4)) 'month/day/year
If Date - d > 30 Then
Kill strBUfolder & strTemp
End If
strTemp = Dir
Loop

Exit_Handler:
Exit Function
Err_Handler:
If Err.Number = 13 Then 'Types do not match
d = Date 'Set to today so that this file doesn't get deleted
Resume Next
Else
MsgBox "Error " & Err.Number & ": " & Err.Description
End If
Resume Exit_Handler
End Function

 

[Tom van Stiphout]

In my version I am assuming the files you are interested in have
8-char filenames. Adjust as needed. One side benefit is that
Mid(strFile, 7, 2) does not blow up if the filename has less than 8
chars.

Function delBU(ByVal strBUfolder As String)
Dim strFile As String
Dim d As Date
On Error GoTo Err_Handler
If Right$(strBUfolder, 1) <> "\" Then strBUfolder = strBUfolder & "\"
strBUfolder = strBUfolder & "????????.*" 'Only looking for 8-char
filenames.
strFile = Dir(strBUfolder)
Do While strFile <> vbNullString
d = DateSerial(Left(strFile, 4), Mid(strFile, 5, 2), Mid(strFile,
7, 2))
If DateDiff("d", d, Date) > 30 Then
Kill strBUfolder & strFile
End If
strFile = Dir
Loop
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

 

[John J.]

Thanks Tom.

The files are longer than 8 characters but I can adopt the idea with a few
more ?'s.

I notice that the dateserial doesn't blow up when strFile is not a valid
date (for instance 00000000). It then tries to convert the number to a valid
date. Indeed works better than Cdate()

What is the reason you prefer
if DateDiff("d", d, Date) > 30 Then
over the shorter
If Date - d > 30 Then

John

 

[Douglas J. Steele]

The problem with DateSerial is that you could have a file name of
20091338xxxx.txt, and DateSerial would happily accept 20091338 as a valid
date.

My recommendation would be to use the IsDate function, just in case:

Function delBU(ByVal strBUfolder As String)
On Error GoTo Err_Handler

Dim strFile As String
Dim strFirst8Chars As String
Dim d As Date

If Right$(strBUfolder, 1) <> "\" Then
strBUfolder = strBUfolder & "\"
End If
strBUfolder = strBUfolder & "*.*"
strFile = Dir(strBUfolder)
Do While Len(strFile) >= 8
strFirst8Chars = Left(strFile, 8)
If IsDate(Format(strFirst8Chars, "####-##-##")) Then
d = DateSerial(Left(strFile, 4), Mid(strFile, 5, 2), _
Mid(strFile,7, 2))
If DateDiff("d", d, Date) > 30 Then
Kill strBUfolder & strFile
End If
End If
strFile = Dir()
Loop

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler

End Function

John: The reason why I use the DateDiff function is because I'm doing date
arithmetic, and would rather use the built-in date arithmetic functions than
rely on numeric arithmetic. Yes, it should result in the same thing, but why
not use functions specifically built for the purpose?

 

[John J.]

One other thing I noticed:
strBUfolder = strBUfolder & "????????.*"
wil make the first dir call to search for a file with 8 characters.
But strFile = Dir will continue searching without that criteria.

John

 

[John J.]

Thanks for the pointer. That's safer.

One detail is that:
Do While Len(strFile) >= 8
will make the function stop if a file is found that has less than 8
characters, while I need the function to continue searching till it has
evaluated all files.

I also noticed that
strBUfolder = strBUfolder & "*.*"
resulted in an error when trying to kill the file.

So I made the following changes and added a number of days feature. It works
like a charm. Thanks again guys for the help!


Function delBU(strBUfolder As String, intNrOfDays As Integer)
On Error GoTo Err_Handler

Dim strFile As String
Dim strFirst8Chars As String
Dim d As Date

If Right$(strBUfolder, 1) <> "\" Then
strBUfolder = strBUfolder & "\"
End If

strFile = Dir(strBUfolder & "*.*")
Do While strFile <> vbNullString
If Len(strFile) >= 8 Then
strFirst8Chars = Left(strFile, 8)
If IsDate(Format(strFirst8Chars, "####-##-##")) Then
d = DateSerial(Left(strFile, 4), Mid(strFile, 5, 2), _
Mid(strFile, 7, 2))
If DateDiff("d", d, Date) > intNrOfDays Then
Kill strBUfolder & strFile
End If
End If
End If
strFile = Dir()
Loop

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler

End Function

John

 

[Douglas J. Steele]

Repeated calls to Dir use the same criteria originally used.

 

[Tom van Stiphout]

I don't think so. The first time you specify the pattern, and
subsequent calls to Dir will continue to use that pattern.

-Tom.
Microsoft Access MVP

 

[John J.]

I falsely derived that from my test. I thought that "????????.*" would
exclude for instance 2 letter filenames, but it doesn't.
Thanks,
John