Macro para poner hipervinculo archivo pdf

Dinkys · el 13 de agosto

Buenos días,

A ver si alguien me puede ayudar con esta macro :

Lo que necesito es poner la ruta que hay + todas las subcarpetas que hay después de \2019 Pedidos\..... y no se como hacerlo,

Gracias de antemano

Sub Proceso_hipervínculo_al_pedido()

Ruta = "\\192.169.11.18\RecursosCompartidos\ADMINISTRACION-VENTAS\Interdepartamental\2019 Pedidos\"

parte = ActiveCell.Value
Set fso = CreateObject("scripting.filesystemobject")
Set carpeta = fso.getFolder(Ruta)
For Each archivo In carpeta.Files
If archivo.Name Like "*" & parte & "*" And Right(archivo, 3) = "pdf" Then
Shell "C:\Program Files (x86)\Adobe\Acrobat DC\Acrobat\Acrobat.exe " & archivo, vbNormalFocus
Exit Sub
Else
End If
Next
MsgBox "No existe pdf"
End Sub

Abraham Valencia · el 13 de agosto

Hola

No me queda claro, o sea ¿quieres listar todos los archivos de esa carpeta y sus sub carpetas siempre y cuando sean pdf? y que además de eso ¿se conviertan en hipervínculos?

Abraham Valencia

Héctor Miguel · el 14 de agosto

Hace 18 horas, Dinkys dijo:

Sub Proceso_hipervínculo_al_pedido()

si entiendo bien, lo que pretendes es...
- buscar un archivo *.pdf cuyo nombre contenga el texto de la "ActiveCell"
- partiendo de una ruta "de base" (EN RED) incluyendo cualquier (posible) sub-carpeta
- una vez localizado (cualquiera este sea), abrirlo con el lector pdf de acrobat

pregunta de base:
si hubiera dos archivos (o más) que cumplen la condición (parcial) del nombre...
- cómo aseguras que "el primero" (que se encuentre) ES/ERA el que espera(ba)s encontrar ?

Dinkys · el 14 de agosto

Hace 2 horas, Héctor Miguel dijo:

si entiendo bien, lo que pretendes es...
- buscar un archivo *.pdf cuyo nombre contenga el texto de la "ActiveCell"
- partiendo de una ruta "de base" (EN RED) incluyendo cualquier (posible) sub-carpeta
- una vez localizado (cualquiera este sea), abrirlo con el lector pdf de acrobat

pregunta de base:
si hubiera dos archivos (o más) que cumplen la condición (parcial) del nombre...
- cómo aseguras que "el primero" (que se encuentre) ES/ERA el que espera(ba)s encontrar ?

Buenos días Hector, has entendido perfectamente. El nombre va a ser único, si hay dos iguales que me salte un mensaje de donde están (pero no creo que haya dos iguales).

Sub-carpetas a partir de esta ruta: "\\192.169.11.18\RecursosCompartidos\ADMINISTRACION-VENTAS\Interdepartamental\2019 Pedidos\"

Y como decía @avalencia me genere un hipervínculo para que la siguiente vez solo sea abrirlo

Esta sería la columna A donde tengo los pedidos y donde pincharía en cualquier pedido para ejecutar la macro :

Y así me están metiendo los pedidos, pero ya les he dicho que el PED sobra, por eso el nº de pedido siempre va a estar en la cadena del nombre.

Muchas gracias anticipadas

Héctor Miguel · el 14 de agosto

Hace 10 horas, Dinkys dijo:

así están los pedidos, pero ya les he dicho que el PED sobra, por eso el nº de pedido siempre va a estar en la cadena del nombre

(creo que) es poco eficiente andar buscando archivo-por-archivo si se encuentra (o no) en una (in)determinada carpeta o seguir buscando en sub-carpetas (sobre todo si el listado es "considerablemente" grande ?)

si puedes normalizar tanto la carpeta (una sola) como el nombre, ya sea que inicie (siempre) con el sufijo (o no) + el numero podrías simplificar los hipervinculos

una alternativa es la función =HIPERVINCULO("ubicación del documento","texto a mostrar en la celda")

otra es insertar hpervinculos como objeto (desde vba: hyperlinks.add .......)

de cualquier forma, la "carga" de fórmulas u objetos va directo al archivo de excel

comenta cual alternativa te parece más asequible a tu situación (?)

Dinkys · el 14 de agosto

Hace 2 horas, Héctor Miguel dijo:

(creo que) es poco eficiente andar buscando archivo-por-archivo si se encuentra (o no) en una (in)determinada carpeta o seguir buscando en sub-carpetas (sobre todo si el listado es "considerablemente" grande ?)

si puedes normalizar tanto la carpeta (una sola) como el nombre, ya sea que inicie (siempre) con el sufijo (o no) + el numero podrías simplificar los hipervinculos

una alternativa es la función =HIPERVINCULO("ubicación del documento","texto a mostrar en la celda")

otra es insertar hpervinculos como objeto (desde vba: hyperlinks.add .......)

de cualquier forma, la "carga" de fórmulas u objetos va directo al archivo de excel

comenta cual alternativa te parece más asequible a tu situación (?)

Quizás me he explicado mal. Para mi si que es eficiente buscar archivo por archivo porque el rango que te he puesto en la imagen es fijo (siempre es A2:A62) pero el nº de pedido en las celdas va cambiando conforme se va terminando de controlar el pedido. No puedo normalizar en una sola carpeta puesto que la documentación va en subcarpetas de clientes y fechas, y esas SI que siempre se van a quedar ahí. La opción de =HIPERVINCULO ya la había pensado, pero tengo que ir uno a uno y cada vez que cambie el pedido generarlo, por eso estaba con la macro puesto que cada vez que cambie el nº la ejecuto y punto. Por eso la alternativa es esa, lo que me falta es completar la búsqueda : Sub-carpetas a partir de esta ruta: "\\192.169.11.18\RecursosCompartidos\ADMINISTRACION-VENTAS\Interdepartamental\2019 Pedidos\" ..... ¿me he explicado ahora mejor?

Héctor Miguel · el 15 de agosto

Hace 10 horas, Dinkys dijo:

¿me he explicado ahora mejor?

perfectamente

el siguiente procedimiento pone un hipervinculo en la columna "B" de cada celda en el rango (columna "A")
si no existe el documento buscado deja "la nota" (en lugar del hipervinculo)

comprueba la constante "base" (no importa si la escribes en [may/min]usculas)

si no quieres el dato en la columna "B", modifica las 3 instrucciones con "celda.Offset(, 1)"
=> por el número de columna distinto de "1" (una a la derecha de cada celda)

probado a nivel local (falta ver su comportamiento "en red" ? -permisos y demás-)
hay métodos 20 veces más rápidos, pero solo trabajan con archivos indizados (LAN no incluidas)

' procedimiento para hacer hipervinculos a documentos segun "patron" en las celdas ' _
  a partir de una ruta "base" (incluyendo sub-carpetas) de tipo *.pdf ' _
  R&D: Héctor Miguel Orozco Díaz (agosto de 2019) '
Option Base 1
Private Const base As String = "\\192.169.11.18\recursoscompartidos\administracion-ventas\interdepartamental\2019 pedidos"
Dim n As Integer, fso As Object, carpeta As Object, subcarpeta As Object, subCarpetas()
Sub HV_al_Pedido(): Application.ScreenUpdating = False: n = 0
  Dim celda As Range, documento As String, ubicacion As String, x As Long
  Set fso = CreateObject("scripting.filesystemobject")
  listaCarpetas base: Set carpeta = Nothing: Set fso = Nothing
  For Each celda In Range("a2:a62") ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '
    celda.Offset(, 1).Clear: celda.Offset(, 1) = "No existe documento"
    For x = 1 To n: documento = Dir(subCarpetas(x) & "\*" & celda & "*.pdf")
      If documento <> "" Then
        ubicacion = subCarpetas(x) & "\" & documento
        celda.Parent.Hyperlinks.Add celda.Offset(, 1), ubicacion, , "Ir al pedido", documento
        Exit For
      End If: Next: Next
End Sub
Private Function listaCarpetas(ruta As String): Set carpeta = fso.GetFolder(ruta): n = n + 1
  ReDim Preserve subCarpetas(n): subCarpetas(n) = carpeta.Path
  For Each subcarpeta In carpeta.SubFolders: listaCarpetas subcarpeta.Path: Next
End Function

Dinkys · el 15 de agosto

Millones de gracias @he

Hace 2 horas, Héctor Miguel dijo:
perfectamente

el siguiente procedimiento pone un hipervinculo en la columna "B" de cada celda en el rango (columna "A")
si no existe el documento buscado deja "la nota" (en lugar del hipervinculo)

comprueba la constante "base" (no importa si la escribes en [may/min]usculas)

si no quieres el dato en la columna "B", modifica las 3 instrucciones con "celda.Offset(, 1)"
=> por el número de columna distinto de "1" (una a la derecha de cada celda)

probado a nivel local (falta ver su comportamiento "en red" ? -permisos y demás-)
hay métodos 20 veces más rápidos, pero solo trabajan con archivos indizados (LAN no incluidas)
' procedimiento para hacer hipervinculos a documentos segun "patron" en las celdas ' _
  a partir de una ruta "base" (incluyendo sub-carpetas) de tipo *.pdf ' _
  R&D: Héctor Miguel Orozco Díaz (agosto de 2019) '
Option Base 1
Private Const base As String = "\\192.169.11.18\recursoscompartidos\administracion-ventas\interdepartamental\2019 pedidos"
Dim n As Integer, fso As Object, carpeta As Object, subcarpeta As Object, subCarpetas()
Sub HV_al_Pedido(): Application.ScreenUpdating = False: n = 0
  Dim celda As Range, documento As String, ubicacion As String, x As Long
  Set fso = CreateObject("scripting.filesystemobject")
  listaCarpetas base: Set carpeta = Nothing: Set fso = Nothing
  For Each celda In Range("a2:a62") ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '
    celda.Offset(, 1).Clear: celda.Offset(, 1) = "No existe documento"
    For x = 1 To n: documento = Dir(subCarpetas(x) & "\*" & celda & "*.pdf")
      If documento <> "" Then
        ubicacion = subCarpetas(x) & "\" & documento
        celda.Parent.Hyperlinks.Add celda.Offset(, 1), ubicacion, , "Ir al pedido", documento
        Exit For
      End If: Next: Next
End Sub
Private Function listaCarpetas(ruta As String): Set carpeta = fso.GetFolder(ruta): n = n + 1
  ReDim Preserve subCarpetas(n): subCarpetas(n) = carpeta.Path
  For Each subcarpeta In carpeta.SubFolders: listaCarpetas subcarpeta.Path: Next
End Function

Millones de gracias Hector, lo he probado en local y funciona. Ya te diré si funciona en red.

Dinkys · el 15 de agosto

Hace 4 horas, Dinkys dijo:

Millones de gracias @he

Millones de gracias Hector, lo he probado en local y funciona. Ya te diré si funciona en red.

Hace 7 horas, Héctor Miguel dijo:
perfectamente

el siguiente procedimiento pone un hipervinculo en la columna "B" de cada celda en el rango (columna "A")
si no existe el documento buscado deja "la nota" (en lugar del hipervinculo)

comprueba la constante "base" (no importa si la escribes en [may/min]usculas)

si no quieres el dato en la columna "B", modifica las 3 instrucciones con "celda.Offset(, 1)"
=> por el número de columna distinto de "1" (una a la derecha de cada celda)

probado a nivel local (falta ver su comportamiento "en red" ? -permisos y demás-)
hay métodos 20 veces más rápidos, pero solo trabajan con archivos indizados (LAN no incluidas)
' procedimiento para hacer hipervinculos a documentos segun "patron" en las celdas ' _
  a partir de una ruta "base" (incluyendo sub-carpetas) de tipo *.pdf ' _
  R&D: Héctor Miguel Orozco Díaz (agosto de 2019) '
Option Base 1
Private Const base As String = "\\192.169.11.18\recursoscompartidos\administracion-ventas\interdepartamental\2019 pedidos"
Dim n As Integer, fso As Object, carpeta As Object, subcarpeta As Object, subCarpetas()
Sub HV_al_Pedido(): Application.ScreenUpdating = False: n = 0
  Dim celda As Range, documento As String, ubicacion As String, x As Long
  Set fso = CreateObject("scripting.filesystemobject")
  listaCarpetas base: Set carpeta = Nothing: Set fso = Nothing
  For Each celda In Range("a2:a62") ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '
    celda.Offset(, 1).Clear: celda.Offset(, 1) = "No existe documento"
    For x = 1 To n: documento = Dir(subCarpetas(x) & "\*" & celda & "*.pdf")
      If documento <> "" Then
        ubicacion = subCarpetas(x) & "\" & documento
        celda.Parent.Hyperlinks.Add celda.Offset(, 1), ubicacion, , "Ir al pedido", documento
        Exit For
      End If: Next: Next
End Sub
Private Function listaCarpetas(ruta As String): Set carpeta = fso.GetFolder(ruta): n = n + 1
  ReDim Preserve subCarpetas(n): subCarpetas(n) = carpeta.Path
  For Each subcarpeta In carpeta.SubFolders: listaCarpetas subcarpeta.Path: Next
End Function

millones de gracias Hector, solo me falta la instrucción para que si la celda está en blanco no ponga nada ¿me puedes ayudar?

Héctor Miguel · el 15 de agosto

Hace 4 horas, Dinkys dijo:

solo me falta la instrucción para que si la celda está en blanco no ponga nada

si las celdas "con datos" son constantes (NO fórmulas) y las celdas "en blanco" están (realmente) vacías...

solo cambia esta instrucción:

  For Each celda In Range("a2:a62") ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '

por esta otra:

  For Each celda In Range("a2:a62").SpecialCells(2) ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '

no olvides que los detalles que te guardas... (se quedan guardados)

Dinkys · el 15 de agosto

Hace 2 horas, Héctor Miguel dijo:
si las celdas "con datos" son constantes (NO fórmulas) y las celdas "en blanco" están (realmente) vacías...

solo cambia esta instrucción:
  For Each celda In Range("a2:a62") ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '
por esta otra:
  For Each celda In Range("a2:a62").SpecialCells(2) ' <= AJUSTA a tu rango real (o hazlo dinamico ?) '
no olvides que los detalles que te guardas... (se quedan guardados)

Millones de gracias Hector.