Macro que realice búsqueda en carpeta externa y subcarpetas de esta a partir de dato en una celda
FELIZ DÍA DE REYES :3
Buenos días tengo una macro que ya me realiza una búsqueda en carpeta externa toma el dato que va a buscar de la columna B de mi libro de excel pero solo realiza la búsqueda en la carpeta que le asigno en la macro ahora lo que necesito es que a partir de una ruta raíz inicie la búsqueda pero si no encuentra el documento en la carpeta principal la busque en las subcarpetas que contenga esta
Ejemplo
Dato a buscar: reporte23--15
Reportes <------------- carpeta dada en la macro o carpeta raiz
Report23-12-14 <------------------documento en carpeta reportes
Reporte enero <------------ subcarpetas
Report2013 <----------documento en carpeta enero
Reporte semana 1 <------------------------ carpeta dentro de la subcarpeta reporte enero
Reporte febrero <-----------------subcarpeta
Reporte marzo<----------------subcarpeta
Reporte abril<---------------------subcarpeta
Reporte mayo <--------------------- subcarpeta
Reporte23--15 <--------------------------documento que se esta buscando
Reporte junio etc
Esta es la macro que tengo
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Act.Por.Dante Amor
If Target.Column <> 2 Then Exit Sub 'sólo se ejecutará en col B'
If Target.Row < 9 Then Exit Sub 'sólo se ejecuta a partir de la fila 9'
If Target.Value = " " Or Target.Value = "" Then Exit Sub no se ejecutara en celdas vacias
'ChDir "C:\Users\cari\Documents\libros\" 'ruta de carpeta donde estan los documentos
ChDir ThisWorkbook.Path & "\"
nombre = Target.Value
If UCase(Right(nombre, 4)) = ".PDF" Then
nuevo = Left(nombre, Len(nombre) - 4)
Else
nuevo = nombre
End If
arch = Dir(CurDir() & "\" & "*" & nuevo & "*.pdf")
If arch <> "" Then
If MsgBox("el archivo existe. Desea abrirlo??", vbYesNo, "ATENCION") = vbNo Then Exit Sub
'ActiveWorkbook.FollowHyperlink CurDir() & "\" & arch
Shell "C:\Program Files (x86)\Adobe\Reader 9.0\Reader\AcroRd32.exe " & arch
Else: y = MsgBox("no fue localizado desea buscarlo manualmente", vbYesNo, "ATENCION")
If y = vbNo Then Exit Sub
On Error GoTo salida
ChDir "C:\Users\cari\Documents\libros\"
archivo = Application.GetOpenFilename
If archivo = False Then Exit Sub
Shell "C:\Program Files (x86)\Adobe\Reader 9.0\Reader\AcroRd32.exe " & archivo
Exit Sub
End If
salida: MsgBox "Listo"
End Sub
Espero se pueda realizar lo que pretendo para hacer mas completa y funcional esta macro de antemano muchas gracias :3