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
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.
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.
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.
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
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
- Compartir respuesta