Macro buscar archivos con parte de nombre y listar coincidencias

[MarianoCruz]

Hola buenas tardes:

 

Tengo un archivo que he adaptado para buscar archivos dentro de una carpeta y subcarpeta poniendo en una celda parte del nombre del archivo y la ruta donde buscar. 

El archivo encontrado lo muestro en la celda 5 de la columna D.

Pero me gustaría agregar a lo siguiente:

Que me muestre todas las coincidencias que encuentre con parte de ese nombre. no importando la extensión ni carpeta o subcarpeta en la que se encuentre.

Para así poder seleccionar el que me interese.

Muchas gracias 

Mariano

Pba. busca arch partenombre en CarpetaySub.xlsm

[JSDJSD]

Prueba y comenta 

[JSDJSD]

El código lo tienes en el mismo botón 

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False
    Dim Fso As Object, Carpeta As Object
    Dim Ruta As String
    Dim Archivo As String
    Dim Resultados As String
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Ruta = Range("B2").Value
    Archivo = Range("C3").Value
    Resultados = ""
    Set Carpeta = Fso.GetFolder(Ruta)
    BuscarArchivos Carpeta, Archivo, Resultados
    Range("D5").Value = Resultados
    Set Fso = Nothing
End Sub

Sub BuscarArchivos(Carpeta As Object, Archivo As String, ByRef Resultados As String)
    Dim CarpetaT As Object
    Dim ArchivoT As Object
    Dim regEx As Object
    
 
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = ".*" & Replace(Archivo, " ", ".*") & ".*"
    
    For Each CarpetaT In Carpeta.SubFolders
        BuscarArchivos CarpetaT, Archivo, Resultados
    Next
    
    For Each ArchivoT In Carpeta.Files
        If regEx.Test(ArchivoT.Name) Then
            Resultados = Resultados & ArchivoT.Path & vbCrLf
        End If
    Next
End Sub

 

Pba. busca arch partenombre en CarpetaySub.xlsm

[MarianoCruz]

En 16/12/2023 at 3:33 , JSDJSD dijo:

El código lo tienes en el mismo botón 

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False
    Dim Fso As Object, Carpeta As Object
    Dim Ruta As String
    Dim Archivo As String
    Dim Resultados As String
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Ruta = Range("B2").Value
    Archivo = Range("C3").Value
    Resultados = ""
    Set Carpeta = Fso.GetFolder(Ruta)
    BuscarArchivos Carpeta, Archivo, Resultados
    Range("D5").Value = Resultados
    Set Fso = Nothing
End Sub

Sub BuscarArchivos(Carpeta As Object, Archivo As String, ByRef Resultados As String)
    Dim CarpetaT As Object
    Dim ArchivoT As Object
    Dim regEx As Object
    
 
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = ".*" & Replace(Archivo, " ", ".*") & ".*"
    
    For Each CarpetaT In Carpeta.SubFolders
        BuscarArchivos CarpetaT, Archivo, Resultados
    Next
    
    For Each ArchivoT In Carpeta.Files
        If regEx.Test(ArchivoT.Name) Then
            Resultados = Resultados & ArchivoT.Path & vbCrLf
        End If
    Next
End Sub

 

Pba. busca arch partenombre en CarpetaySub.xlsm 24.73 kB · 6 descargas

Hola buenas tardes:

Gracias por la respuesta ya he probado la macro y si funciona, pero el resultado no debe estar en una solo celda, si no poner en cada celda el o los resultados encontrados a partir de la celda D5 hacia abajo. es decir, si las coincidencias son 2 los pondrá en dos celdas y así según la cantidad de resultados.

Muchas gracias 

[JSDJSD]

Intenta modificarla, y si no lo consigues dilo y te la modifico

[MarianoCruz]

Hola, si, lo voy a realizar. Gracias por el respaldo. 

[Héctor Miguel]

En 15/12/2023 at 12:22 , MarianoCruz dijo:

Que me muestre todas las coincidencias que encuentre con parte de ese nombre. no importando la extensión ni carpeta o subcarpeta en la que se encuentre.

Para así poder seleccionar el que me interese.

analiza el adjunto y comprueba si funcionan los hipervinculos

find partName (ayudaExcel).xlsm