Hipervínculos de todos los archivos de una carpeta Access
He acudido aquí en varias ocasiones y me han ayudado muchísimo, gracias anticipadas por darse el tiempo de ayudarme.
Mi problema es el siguiente, en una base de datos en Access:
Mediante un formulario inserto Hipervínculos de archivos PDF a una tabla, mediante control+k, navegando a la carpeta indicada y seleccionando el archivo PDF los tengo separados por año, posteriormente tengo otro formulario de búsqueda donde por nombre del archivo busco el archivo PDF, conforme voy escribiendo se va rediciendo la búsqueda hasta aparecer el archivo buscado, al dar doble clic sobre este, me abre un visor web donde muestra el PDF.
Pero esto lo debo hacer archivo por archivo para crear el hipervínculo y tengo más de mil, me gustaría saber si se pueden crear de alguna manera hipervínculos de de todos los archivos de una carpeta.
2 respuestas
Puede utilizar este procedimiento para llenar la taba con los hipevinculos
Tengo este directorio
Formulario
Hago clic en el botón y obtengo
Código del botón
Private Sub btnLlenar_Click()
On Error GoTo hay_error
Dim rutaCarpeta As String
Dim nombreArchivo As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rutaCompleta As String
Dim hipervinculo As String
rutaCarpeta = "E:\BibliotecaFuncionesEPF\CodigoQR_VBA\"
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblhipervinculo")
nombreArchivo = Dir(rutaCarpeta & "*.pdf", vbNormal)
Do While nombreArchivo <> ""
If Right(nombreArchivo, 4) = ".pdf" Then ' Solo procesar archivos con extensión .pdf
rutaCompleta = rutaCarpeta & nombreArchivo
hipervinculo = "#" & rutaCompleta
rs.AddNew
rs("hipervinculo").Value = hipervinculo
rs.Update
End If
nombreArchivo = Dir
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
If Err.Number = 0 Then
MsgBox "Proceso concluido satisfactoriamente", vbInformation, "Le informo"
End If
hay_error_exit:
Exit Sub
hay_error:
MsgBox "Ocurrió el error " & Err.Description & vbCrLf & Err.Description, vbCritical, "Error..."
Resume hay_error_exit
End SubTrate de adaptarlo a sus necesidades
Gracias..., es exactamente lo que necesitaba lo adapte como me indicaste y funciona perfecto, pero abusando, habrá alguna manera de ejecutarlo y que solo me cree los hipervínculos de los archivos nuevos, es decir si en la carpeta tenia 50 archivos PDF y lo ejecuto me crea esos 50 hipervínculos y después pego en la carpeta otros 50 me cree solo los 50 nuevos más los 50 que ya estaban en la tabla, porque por ahora me crea los nuevos y crea nuevamente los que ya estaban.
Gracias nuevamente.
Yo lo intente con una búsqueda de eliminar duplicados, pero me marca error con el tipo de datos OLE.
Claro ese caso defina el campo hipervínculo de la tabla indexado sin duplicados.
Gracias. Lo intento pero me sale el siguiente error y no crea los nuevos hipervínculos, solo quedan los iniciales.
Si efectivamente es necesario modificar el código por el siguiente:
Private Sub btnLlenar_Click()
On Error GoTo hay_error
Dim rutaCarpeta As String
Dim nombreArchivo As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rutaCompleta As String
Dim hipervinculo As String
Dim lnCuenta As Long
rutaCarpeta = "E:\BibliotecaFuncionesEPF\CodigoQR_VBA\"
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblhipervinculo")
nombreArchivo = Dir(rutaCarpeta & "*.pdf", vbNormal)
Do While nombreArchivo <> ""
If Right(nombreArchivo, 4) = ".pdf" Then ' Solo procesar archivos con extensión .pdf
rutaCompleta = rutaCarpeta & nombreArchivo
hipervinculo = "#" & rutaCompleta
rs.AddNew
rs("hipervinculo").Value = hipervinculo
rs.Update
lnCuenta = lnCuenta + 1
End If
nombreArchivo = Dir
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
If Err.Number = 0 Then
If lnCuenta > 0 Then
MsgBox "Proceso concluido satisfactoriamente" & vbCrLf & _
"Se procesaron " & lnCuenta & " archivos", vbInformation, "Le informo"
Else
MsgBox "No se adicionaron archivos a la tabla", vbInformation, "Le informo"
End If
End If
hay_error_exit:
Exit Sub
hay_error:
If Err.Number = 3022 Then
lnCuenta = lnCuenta - 1
Resume Next
Else
MsgBox "Ocurrió el error " & Err.Description & vbCrLf & Err.Description, vbCritical, "Error..."
Resume hay_error_exit
End If
End SubEl campo hipervínculo de la tabla debe ser Requerido SI e indexado y SIN duplicados
¡Gracias!
Funciona perfectamente, es justo como lo necesitaba, me gustaría saber más de vba, [email protected]
Gracias nuevamente.
Me alegro, a su correo le envíe la información sobre cursos de Access y VBA
Si tengo una tabla Clientes, con la que hago un formulario
Cuando pulso el botón Asignar ruta, aunque la instrucción podría estar en cualquier otro evento. Se abre un explorador para que seleccione la carpeta de donde voy a sacar los archivos. En este caso la carpeta sólo tiene unos pocos archivos
Selecciono la carpeta BasesPracticas y en cuanto pulso Aceptar, me deja el formulario como
Luego, en caso de que quiera ver alguno pulso su botón correspondiente de VER y me abre ese documento, usando simplemente Application. Followhyperlink, ya que no necesitas los hipervínculos para nada en las tablas. Creo recordar que Sveinborj ya te dijo una vez que los hipervínculos eran una mier...
Si te interesa, repito, si te interesa, mándame un mensaje ( sólo el mensaje) a [email protected] y te mando el ejemplo. Si lo haces, en el asunto del mensaje pon tu alias Ismael Luna, ya que si no sé quien me escribe ni los abro.