Excel. Macro para buscar archivos y generar ruta
Busco la manera de localizar archivos (extensión pdf y dxf) referenciados en una tabla excel haciendo un barrido dentro de una carpeta "padre" y sus subcarpetas y generar sus rutas en una columna. Para que sea más rápido, no sé si es posible marcar que busque primero cerca a la ubicación del archivo Excel hasta completar la búsqueda en toda la carpeta "padre". Si no encuentra nada vale con que las celdas de la columna elegida queden vacías.
2 Respuestas
Aclara por favor si ya sabes el nombre de la carpeta 'padre' o hay que buscarla. Y ya de allí el programa tomará las subcarpetas devolviéndote las rutas.
Y si puedes deja una imagen o comenta cuál es la col con los nombres de los archivos, si están con la extensión y en qué col debe colocarse la ruta.
Voy a intentar explicarme mejor. Tengo que ir generando tablas Excel con listados de referencias de artículos en la col A. Algunas de estas referencias tienen asociados dos archivos pdf y/o dxf con el mismo nombre que la referencia. Esto último lo indica la col C (Valor "T" ambos archivos, "F1" y F2" solo pdf y el resto ninguno) . La dificultad está en que la ubicación de las tablas Excel y los archivos no tienen una lógica repetida. Todo está dentro de una gran carpeta padre que contiene una gran cantidad de carpetas y subcarpetas por donde se distribuyen. Lo que pretendo es crear vínculos para abrir los archivos desde la tabla Excel. Para ello, como mínimo, necesito que se haga una búsqueda automática de los archivos y me devuelva la ruta en la col C.
Perdón, me he confundido. la ruta la devolvería en la col B.
Esta es la macro según lo que entendí y la imagen es el resultado. En mi caso, la ruta de mi libro llega hasta 'Propios'.
He visto en tu consulta anterior que la ruta de tu libro llega hasta Lista, de ahí que se colocaron las 2 primeras instrucciones para encontrar la ruta de las otras 2.
Imaginé que en col A no llevan la extensión y que los archivos pueden estar sueltos en la carpeta PDF o dentro de algunas subcarpetas. Y que en la misma celda de col B se colocarán las 2 carpetas en caso de T.
Dim dire As String
Sub agregaRutas()
'x Elsamatilde
'se establecen las rutas
ruta1 = Replace(ActiveWorkbook.Path, "Listas", "PDF")
ruta2 = Replace(ActiveWorkbook.Path, "Listas", "DXF")
'se recorre la col A desde fila 2 hasta encontrar celda vacía. Fin de rango
[A2].Select
While ActiveCell <> "" And ActiveCell.Offset(0, 2) <> ""
dato = ActiveCell.Value: dire = ""
'se mira si en col C hay alguna clave
If ActiveCell.Offset(0, 2) = "F1" Then 'pdf
tipo = "pdf"
Call buscarF(dato, ruta1, tipo)
ElseIf ActiveCell.Offset(0, 2) = "F2" Then 'dxf
tipo = "dxf"
Call buscarF(dato, ruta2, tipo)
ElseIf ActiveCell.Offset(0, 2) = "T" Then 'las 2
tipo = "pdf"
Call buscarF(dato, ruta1, tipo)
tipo = "dxf"
Call buscarF(dato, ruta2, tipo)
End If
If dire <> "" Then ActiveCell.Offset(0, 1) = Trim(dire)
'continúa con el siguiente registro
ActiveCell.Offset(1, 0).Select
Wend
MsgBox "Fin del proceso."
End Sub
Sub buscarF(refer, dir1, exten)
Dim fs, carpeta, subcarpeta
Set fs = CreateObject("Scripting.FileSystemObject")
Set carpeta = fs.GetFolder(dir1)
'se busca el archivo. Si no está se recorren las subcarpetas
For Each Archi In carpeta.Files
If Archi = carpeta & "\" & refer & "." & exten Then
dire = dire & " " & carpeta
Exit For
End If
Next
'se buscan las subcarpetas dentro de carpeta
For Each subcarpeta In carpeta.SubFolders
'a continuación se miran los archivos
For Each Archi In subcarpeta.Files
If Archi = subcarpeta & "\" & refer & "." & exten Then
dire = dire & " " & subcarpeta
Exit For
End If
Next
Next
End SubSdos y no olvides valorar la respuesta.
Si luego te surge hacer algún cambio x favor en nueva consulta, con todos los detalles.
¡Gracias! Me funciona perfectamente. Tengo que hacer algunos ajustes. Si tengo algún problema con ellos te consultaré de nuevo como mencionas.
