Como Imprimir todos los PDF cuyo hipervínculo tengo en una consulta

Tengo una consulta que enlaza unas archivos en pdf, manifiestos en hipervínculo, la idea es listar la consulta y que me imprima todos los pdf de esta consulta sin tener que abrirlos,

Gracias por la colaboración

1 Respuesta

Respuesta
1

El Búho en su día creó una función para hacerlo:

'---------------------------------------------------------
'
' PrintFile
'
' Código escrito originalmente por Francisco Javier García
' Aguado (Búho)
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
' [email protected]
'
' Este código se brinda por cortesía de
' Francisco Javier García Aguado (Búho)
'
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Function FormatMessage Lib "kernel32" _
Alias "FormatMessageA" _
(ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long) As Long
Private Const SW_HIDE = 0&
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
' función que imprime un documento de cualquier aplicación
Public Function PrintFile(FileName As String) As Variant
Dim RetVal As Long
Dim sError As String
Dim LenMsg As Long
' se manda imprimir el documento
RetVal = ShellExecute(0&, "print", FileName, 0&, vbNullString, SW_HIDE)
' si se ha producido algún error
If RetVal < 33 Then
sError = Space(1024)
' obtenemos el mensaje de error que manda el sistema
LenMsg = FormatMessage( _
FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, _
RetVal, _
0&, _
sError, _
Len(sError), _
0&)
' devolvemos el mensaje de error
PrintFile = Left(sError, LenMsg - 1)
Else
' la función tuvo éxito
PrintFile = True
End If
End Function
'---------------------------------------------------------

Para ejecutarla, por ejemplo desde un botón:

Dim rst AS DAO.recordset
Set rst=CurrentDb.OpenRecordset("C_Final")
If rst.RecordCount=0 Then Exit Sub
rst.MoveFirst
Do Until rst.EOF
PrintFile(rst(1))
rst.moveNext
Loop
Rst. Close

Y en el foro mvp-access dan la solución para que los imprima por orden: http://www.mvp-access.com/foro/imprimir-ficheros-pdf-desde-vba_topic83077.html

Un saludo.


     bit.ly/ForoNkSv 

Tenía la "mosca detrás de la oreja" con el código que te propuse, por el tema de ser un hipervínculo, y hay que hacerle una corrección, para eliminar los caracteres "extraños" que access introduce en los hipervínculos:

Dim rst As DAO.Recordset
Dim archivo As String
Set rst = CurrentDb.OpenRecordset("TDatos")
If rst.RecordCount = 0 Then Exit Sub
rst.MoveFirst
Do Until rst.EOF
   archivo = Left(rst(1), Len(rst(1)) - 1)
   archivo = Right(archivo, Len(archivo) - 1)
   PrintFile (archivo)
   rst.MoveNext
Loop
rst.Close
Set rst = Nothing

¡Gracias!

ya lo probé, pero no logro imprimir nada, no se que me falta, cree la función y modifique el código del botón, con el ultimo que me envió,  pero no logro generar impresión, no se que me falta la verdad estoy bloqueada, la idea es que se genera esta consulta con los manifiestos de importación de un pedido y es necesario imprimirlos, la idea es que al darle click al botón se impriman todos los manifiestos del listado sin tener que abrir Adobe, que se vayan directamente a la impresora. gracias por su colaboración.

Aun no lo logro que se imprima los documentos de los hipervínculos 

No sé qué pasó, pero no llegó el segundo mensaje que te envié, con una BD de ejemplo que a mi en varios ordenadores me funciona para imprimir archivos.

Te lo envío de nuevo: http://filebig.net/files/rckkk8Hua6 

En el archivo comprimido, verás una carpeta que has de poner en C:/ para que encuentre la ruta de los archivos. Los códigos del Formulario Prueba1 son los que te puse en mi primera respuesta, y los del Prueba2, otro que también funciona.

¡Gracias!

Listo ya lo descargue lo reviso y te cuento mil gracias

Feliz día

Buenas tardes 

Ya me da pena molestarlo tanto, le cuento que acabo de revisar el archivo que me envió y funciona perfecto pero cuando genero la consulta con mis datos no me funciona, valide unos poco hipervínculos para validar si era por esto estaba generando problemas y a veces funciona y a veces no, y la verdad no me puedo dar el lujo de a veces si a aveces no, te envió mi archivo para que lo mires a ver que me estoy enredado. http://www.filebig.net/files/3M4NUaBD6J

Hola

Me faltaron los archivos adjuntos. gracias

http://www.filebig.net/files/n4N6XKMijL 

Lo miro esta tarde y te digo algo.

¡Gracias! 

Ya veo el problema. Tus campos de hipervínculo contienen más datos de hipervínculo que los míos, con lo que las fórmulas para dejar solo el nombre del archivo no valen, y por eso a veces te funciona y otras no.

Además, veo que tus hipervínculos no parten de la ruta completa, sino de una ruta relativa (empiezan por .. en vez de por una letra de unidad).

Te paso un código que contempla cualquier supuesto tenga los datos que tenga dentro del hipervínculo (comprobado que funciona):

Private Sub cmdImprimir_Click()
Dim rst As DAO.Recordset
Dim archivo As String
Set rst = CurrentDb.OpenRecordset("C_Final")
If rst.RecordCount = 0 Then Exit Sub
rst.MoveFirst
Do Until rst.EOF
   archivo = Mid(rst(1), InStr(rst(1), "#") + 1, InStrRev(rst(1), "#") - InStr(rst(1), "#") - 1)
   archivo = Replace(archivo, "..", Application.CurrentProject.Path)
   PrintFile (archivo)
   rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

La línea que contiene el Replace, solo la has de poner si alguno de tus hipervínculos empieza por ..\

Te resubo tu archivo con esos cambios: http://filebig.net/files/cJPt4dNTFE 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas