Buscar archivos en subcarpetas (fso)

Necesito un poco de ayuda con una duda.

Estoy intentando hacer una macro que busque un archivo en una carpeta y subcarpetas.

Utilizo el fso y he logrado encontrar un archivo en una carpeta pero no logro entender como buscar en subcarpetas.

1 Respuesta

Respuesta
1

Yo escribí esta función, mira si te sirve. En versiones anteriores a Excel 2010 quizás sea necesario establecer una referencia a la librería "Microsoft Scripting Runtime" (desde Herramientas->Referencias).

La sintaxis es:

=BuscarFichero("Ruta";"Fichero.extensión")

Private sFicheroBuscado As String, sFicheroEncontrado As String
Public Function BuscarFichero(sRutaInicial As String, sFich As String) As String
    Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object
     Dim Fichero As Object, tmpFichero As Object
     Dim strRutaInicial As String
     sFicheroBuscado = LCase(sFich)
     sFicheroEncontrado = ""
     strRutaInicial = "P:\Datos\Excel" 'Ruta que se procesará
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fCarpeta = fso.GetFolder(sRutaInicial)
     For Each tmpFichero In fCarpeta.Files
         If LCase(tmpFichero.Name) = sFicheroBuscado Then
             BuscarFichero = tmpFichero.Path
             Exit Function
         End If
     Next tmpFichero
     BuscarEnSubcarpetas sRutaInicial
     If sFicheroEncontrado <> "" Then
         BuscarFichero = sFicheroEncontrado
         Exit Function
     End If
     BuscarFichero = "Fichero no encontrado"
End Function
Private Sub BuscarEnSubcarpetas(RutaInicial As String)
     Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object
     Dim Fichero As Object, tmpFichero As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fCarpeta = fso.GetFolder(RutaInicial)
     For Each tmpCarpeta In fCarpeta.SubFolders
         For Each tmpFichero In tmpCarpeta.Files
             If LCase(tmpFichero.Name) = sFicheroBuscado Then
                 sFicheroEncontrado = tmpFichero.Path
                Exit Sub
            End If
         Next
        BuscarEnSubcarpetas tmpCarpeta.Path
    Next
End Sub

Si hay muchas carpetas y/o ficheros, me temo que el código puede tomarse su tiempo, pero no he encontrado otra forma más rápida de hacer esto.

Tengo algunas dudas:

1- Puse esto en un Modulo y no se como ejecutarlo. Probé ponerlo en la hoja directo y tampoco. Disculpa lo básico de mis conocimientos.

2- Esto debería adaptarlo a una macro donde luego de encontrar el fichero (txt) lo abre y lo importa a excel para otros procesos. Como puedo incorporarlo?

Esta es la parte de lo que tengo relativo a la apertura del archivo:

Sub detalle()
Dim vCodigo, vEvent As String
Dim vExiste As Boolean
On Error Resume Next
Sheets("eventlog").Select
Columns("A:Z").Select 'selecciono y
Selection.ClearContents 'elimino datos anteriores
Set vCeldaactual1 = Range("A1")
vArchivo = Application.GetOpenFilename(fileFilter:= _
"Archivos de texto (*.txt;*.lst),*.txt;*.lst", Title:="Importar Eventlog")
If vArchivo <> False Then
vNumArchi = FreeFile()
Open vArchivo For Input As #vNumArchi
Range("A1").Select
Do While Not EOF(vNumArchi)
Line Input #vNumArchi, vResultado
vCeldaactual1.Value = vResultado
Set vCeldaactual1 = vCeldaactual1.Offset(1, 0)
Loop
Close vNumArchi
End If

....

Gracias por tu tiempo

Supongo que tendrás que quitar la línea con el GetOpenFilename y asignarle directamente a vArchivo el resultado devuelto por la función BuscarFichero, algo como:

vFichero = BuscarFichero("C:\ruta","Importar Eventlog.extensión")

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas