Visual Basic - Ayuda please

Hola a to2. Me estoy rompiendo los cuernos con esto y no puede ser. Necesito saber si existe una función o algo (LO QUE SEA) q me permita a partir de un directorio borrar todos los archivos (solo archivos) q por ejemplo sean inferiores al día actual q estén por debajo de ese directorio.

P.e. Parto del directorio C:\Trazas y por debajo de aqui tengo una estructura de subdirectorios y archivos (me da igual cual sea). El caso es que solo quiero borrar los archivos inferiores al día de hoy.

El saber qué son archivos y qué son directorios ya lo tengo, pero no soy capaz de recorrerme los sub-directorios de forma satisfactoria. Os paso el código que estoy usando, a ver si alguien ve lo que me falta

Private Function BorrarFicheros(ByVal Directorio As String)
Dim Fichero As String

'Buscamos los ficheros en el directorio
Fichero = Dir(Directorio & "*.*", vbDirectory)
Do Until Fichero = ""
If Fichero <> "." And Fichero <> ".." Then
'Si es un fichero comparamos la fecha
If (GetAttr(Directorio & Fichero) And vbArchive) = vbArchive Then
If Format(FileDateTime(Directorio & Fichero), "yyyymmdd") < Format(Now, "yyyymmdd") Then
Kill (Directorio & Fichero)
End If
'Si es un directorio...
ElseIf (GetAttr(Directorio & Fichero) And vbDirectory) = vbDirectory Then
Directorio = Directorio & Fichero & "\"
BorrarFicheros Directorio
End If
End If
Fichero = Dir
Loop
End Function

Se va metiendo bien por los subdirectorios pero solo por la primera rama cuando ha de saltar a la segunda me casca en la línea Fichero = Dir. Parece que se guarda el valor de la variable Fichero de la ultima instancia q se ha hecho a la función.

¿Alguien me puede echar un cable, o dos?

Gracias por adelantado

Buenas,

Yo tuve un problema parecido y lo solucione de la siguiente manera, te mando el código para que le eches un vistazo, yo lo tengo probado y funciona, es practicamente igual al tuyo pero con la salvedad de que me guardo todas las carpetas de primer nivel antes de empezar para que al volver a la segunda rama o sucesivas no rompa. Tienes que agregar la referencia : WINDOWS SCRIPT HOST OBJECT MODEL. El código es este:

Const INICIO = "c:\"
Dim CarpetasPrimerNivel() As String
Private Sub LeerPrimerNivel()
Dim Fs As New FileSystemObject
Dim Carpeta As String
Dim I As Integer
I = 0
ReDim Preserve CarpetasPrimerNivel(I)
Carpeta = Dir(INICIO, vbDirectory)
Do While Carpeta <> ""
If InStr(Carpeta, ".") = 0 Then
I = I + 1
ReDim Preserve CarpetasPrimerNivel(I)
CarpetasPrimerNivel(I) = INICIO & Carpeta & "\"
End If
Carpeta = Dir
Loop
Set Fs = Nothing
End Sub
Private Sub LeeNivel(C As String)
Dim Fs As New FileSystemObject
Dim Folders() As String
Dim Folder As String, Fic As String
Dim Nf As Integer, I As Integer
I = 0
ReDim Preserve Folders(I)
Folder = Dir(C & "\", vbDirectory)
Do While Folder <> ""
If InStr(Folder, ".") = 0 Then
I = I + 1
ReDim Preserve Folders(I)
Folders(I) = Folder & "\"
End If
Folder = Dir
Loop
For I = 1 To UBound(Folders)
LeeNivel C & Folders(I)
Next I
Fic = Dir(C & "\", vbArchive)
Do While Fic <> ""
'ACCIONES A REALIZAR CON LOS FICHEROS
Fic = Dir
Loop
Set Fs = Nothing
End Sub
Private Sub Form_Load()
Dim Fs As New FileSystemObject
Dim TI As Long, TF As Long
Dim I As Integer, Nf As Integer
TI = Timer
If Right(INICIO, 1) <> "\" Then INICIO = INICIO & "\"
LeerPrimerNivel
For I = 1 To UBound(CarpetasPrimerNivel)
LeeNivel CarpetasPrimerNivel(I)
Next I
If Not Fs.FileExists(App.Path & "\Logs\Backup_" & Format(Date, "YYYYMMDD") & ".log") Then
Nf = FreeFile
Open App.Path & "\Logs\Backup_" & Format(Date, "YYYYMMDD") & ".log" For Output As #Nf
Print #Nf, "No se ha actualizado ningún fichero."
Close #Nf
End If
Set Fs = Nothing
TF = Timer
MsgBox "Backup Terminado." & Chr(13) & "Tiempo utilizado : " & (TF - TI) & " segundos."
Unload Me
End
End Sub

Espero te sirva.

Saludos.

MUCHAS GRACIAS POR CONTESTAR!!!!

Aunque ayer ya le encontré una solución. Al final antes de borrar los ficheros me cargo en una colección todos los subdirectorios que hay. Y después me recorro la colección.

No obstante tendré muy en cuenta tu solución no vaya a ser q a la mía se le escape algo y la liemos :))

De nuevo gracias por contestar tan rápido

Saludos