Envío de informe personalizado con nombre y correo

Tengo un informe llamado I_Mayor que contiene toda la información de los mayores de una constructora y necesito enviar dicho informe a cada uno de los Jefes de Obra filtrado por la obra que le corresponda y a su correo y con el nombre del pdf asignado por el nombre de la obra, para ello cuento con una consulta llamada C_Mayor_Trabajador y que contiene la siguiente información

Me gustaría crear un botón que me envíe el informe I_Mayor filtrado por el código de la obra y con el nombre del fichero compuesto por el NPdf con formato Pdf y al correo del trabajador, si fuese posible en un solo correo agrupar todos los mayores que le corresponda a ese trabajador y si no es posible pues correo por cada obra, ahora lo que hago es exportar el fichero a pdf y luego lo envío por correo, este es código que uso:

DoCmd.OpenReport "I_MAYOR", acViewPreview, "", "[CODIGO]= '" & Me.CODIGO & "'", acHidden
DoCmd.OutputTo acOutputReport, "I_MAYOR", "PDFFormat(*.pdf)", "C:\INF\Me.NPdf&".PDF", False, "", , acExportQualityPrint
DoCmd.Close acReport, "I_MAYOR"

Me gustaría que con solo pulsar el botón envíe todos los correos personalizados con sus mayores a cada uno de los trabajadores de la cosulta C_Mayor_Trabajador ( por supuesto el informe I_Mayor contiene el campo CODIGO.

2 respuestas

Respuesta

En principio, parece que ya dispones de las herramientas necesarias:

.- Ya conoces como crear los informes en PDF
.- En post anteriores envías correos con adjuntos
    (A grupos con el mismo informe y a los integrantes de grupo individualmente)
.- Has creado una selección de destinatarios

Solo has de crear un bucle que genere el pdf (al generarlo le puede asignar el nombre) y a continuación lo envíe, tras ello cierre el informe para reproducir el ciclo con el siguiente destinatario y se repite el ciclo mientras existan destinatarios.

Lo único que has de cambiar en los envíos individuales (algo que ya conoces) es generar los informes personalizados y estos se pueden generar de forma previa o en tiempo de ejecución.

¿Qué haces con los archivos PDF una vez que se envía el correo?.

Gracias Enrique por tu ayuda, yo lo que hago es primero exportar los ficheros a PDF.

Private Sub Comando361_Click()
Me.Requery
Dim P As Integer
If DCount("*", "T_Mayores") > 0 Then

DoCmd.GoToRecord , , acFirst
For P = 1 To Me.Recordset.RecordCount
DoCmd.OpenReport "I_MAYOR", acPreview, , "CODIGO='" & Me.CODIGO & "'", acHidden
DoCmd.OutputTo acOutputReport, "I_MAYOR", "PDFFormat(*.pdf)", "C:\INF2\" & "" & Me.NPdf & "" & ".pdf", False, "", , acExportQualityPrint
DoCmd.Close acReport, "I_MAYOR"
DoCmd.GoToRecord , , acNext
Next
End If

y luego los mando por correo:

Private Sub Comando306_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Mayores"
.Body = "Adjunto envío los mayores"
'Se pueden adjuntar ficheros

'ELVIRIA 8
.Attachments.Add ("C:\INF\ELVIRIA 8.pdf")
.Attachments.Add ("C:\INF\X-ELVIRIA 8.XLSX")

.Send 'tambien se puede usar .Send y lo situa en la bandeja de salida

End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Correo enviado"

(así por cada Jefe de obras, poniendo manualmente el informe que envío)

Por eso me gustaría automatizar el proceso y que en un solo botón me envíe a cada Jefe de Obra todos los mayores que le corresponda con la tabla que comienza mi pregunta, gracias.

Por favor ten paciencia conmigo que no estoy muy ducho en este tema.

Con  vuestra ayuda he hecho la siguiente instrucción, pero solo me envía el mayor de la obra del registro en el que estoy posicionado(formulario basado en la consulta del inicio de la pregunta) y con el nombre de I_Mayor, no lo personaliza ni se como avanzar para que lo haga con todos .

Private Sub Comando6_Click()
Dim Tbl_Temp As DAO.Recordset, Destinos$
Set Tbl_Temp = CurrentDb.OpenRecordset("SELECT correo FROM C_Mayor_Trabajador WHERE imprimir <> 0 and [CODIGO]= '" & Me.CODIGO & "'", , dbReadOnly) ''

With Tbl_Temp
If Tbl_Temp.RecordCount = 0 Then MsgBox "No hay destinatarios": Exit Sub
Do Until .EOF
If Len(Destinos) <> 0 Then Destinos = Destinos & ";"
Destinos = Destinos & !Correo
.MoveNext
Loop
.Close
End With
Set Tbl_Temp = Nothing
DoCmd.OpenReport "I_MAYOR", acViewPreview, "", "[CODIGO]= '" & Me.CODIGO & "'", acHidden
DoCmd.SendObject acReport, "I_Mayor", "PDFFormat(*.pdf)", "****@hotmail.com", "", Destinos, "Notificacion", "Adjunto: Mayor en formato pdf", False, ""
DoCmd.Close acReport, "I_MAYOR"

End Sub

No me has respondido a la pregunta: ¡¿Qué haces con los PDFs una vez que los envías?

Utilizas el método clásico para generarlos personalizados:
.- Abrir el informe con condiciones
,. Con el abierto envías el informe 'sin condiciones' (como esta abierto y no permite duplicar instancias) asume el que 'esta abierto y condicionado' y lo envía.

¿Qué ocurre si no se abre condicionado (o se cierra si está condicionado) y se envía?.

Si los que se crean en pdf dejan de ser útiles tras enviarlos ...

Se puede aplicar un simple método que permite condicionarlos y enviarlos sin necesidad de crearlos, mantenerlos abiertos y cerrarlos tras utilizarlos (o guardarlos para envío posterior) esto es: menos trabajo = mas eficiencia.

una vez que lo envío los machaco el próximo mes cundo vuelvo a generar los mayores, pero no tengo necesidad de exportarlos si supiera enviarlos directamente.

Tienen que abrirse para poder filtrarse porque no esta contemplado abrir el informe con parámetros, pero eso ... se puede emular.

Te propongo un experimento y si te convence se aplica y disfruta.

Crea una variable publica de tipo texto en un modulo independiente (interesa que aun vacía exista por si se la utiliza sin necesidad), puedes llamarla 'Temp_Condicion', para que no interfiera (cuando no se utilice) al dejar de necesitarla se le asigna una cadena vacía.

Se tiene que añadir algo de código (para emular la propiedad OpenArgs del informe):

Private Sub Report_Open(Cancel As Integer)
If Temp_Condicion <> "" Then Me.Filter = Temp_Condicion: Me.FilterOn = True
End Sub

Y ahora el experimento:

Paso uno: darle contenido a la variable (la condicion que ya se esta utilizando)

Temp_Condicion = "Codigo = " & Me.Codigo

Paso dos: enviarlo, en lugar de  'Me.Codigo' un codigo conocido en lugar de  ([email protected]) mejor pon el que utilices para que veas lo que se envía:

DoCmd.SendObject acReport, "I_MAYOR", "PDFFormat(*.pdf)", "[email protected]", "", "", "Asunto, el envio de informacion", "Adjunto inform de: " & [aqui la empresa], False, ""

Estamos experimentando, así que pon otro código diferente en la condición y vuelve a ejecutar el envío.

Si te convence creamos el bucle que los envía.
-- Seria interesante que en cada registro figurasen los datos variables que se utilizaran en cada correo (además de la direccion), se añadirian en el titulo o en el cuerpo del correo --

Enrique, me da error

DoCmd.SendObject acReport, "I_MAYOR", "PDFFormat(*.pdf)", "facturacion@***.com", "", "", "Asunto, el envio de informacion", "Adjunto inform de: " & "Red Point", False, ""

Creo que la dirección de correo no es una dirección valida, el dominio = ***  no me parece correcto

Enrique, la dirección de correo es correcta tan solo he puesto *** por no publicar mi correo

Apreciaras que en ese código y después del formato de salida hay tres apartados:
El primero : son las direcciones visibles: el apartado 'Para ..'
El segundo: se corresponde con 'CC ...'
El tercero: se corresponde con 'CCO..'
Si alguno no se utiliza se le ponen unas comillas vacías "" (cadena de texto vacía), en los que se utilicen han de tener direcciones correctas (separadas en el caso de ser mas de una con el separador de listas de la configuración regional del sistema).

El separador en la configuración de España (el castellano) es el punto y coma, la coma simple ... es el separador decimal.

¿Qué dice exactamente el mensaje de error?

Y si le adjudicas un ID a la variable (después será el que corresponda) y se abre el informe (como informe) ¿Aparece filtrado por el Código?.

Temp_Condicion = "Codigo = 122"
o asi:
Temp_Condicion = "Codigo = " & 122

Después se abre en vista previa y deberá aparecer con los datos del código 122

El método de envío ya lo has utilizado con éxito y puedes aplicar el de generar un mensaje desde cero o cualquier método que te funcione.
Cuando logres enviarlo es el momento de crear el bucle y el botón que lo ejecute.

no necesito enviar con copia ni copia oculta, por eso lo he dejado tal y como me lo has enviado, pero acabo de hacerlo ahora pero me genera un solo fichero con el nombre Mayores.pdf con todos los registros sin filtrar.

¿Has creado la variable publica y has modificado el informe para que la variable haga su función?

Para crear el informe filtrado 'virtualmente' y enviarlo en el correo es imprescindible modificar el informe para que aplique la condición al momento de generarlo, si la variable no tiene valor (sea 'Temp_Condicion' o como desees llamarla) no se le aplicara el filtro ni se la activara, si no la entiende (y seria extraño, porque es la misma que utilizas para utilizar el método clásico) no la aplicara y saldrá el informe sin filtrar.

En un modulo independiente (si no tiene uno habrá que crearlo) se crea la variable y debería funcionar.
También se puede crear en el modulo actual (donde esta el botón), pero solo existirá si el objeto en la que se declara esta abierto.

Por favor me puedes decir como modificar el informe para que aplique la condición 

Lo publique antes, lo reitero:
-----------------------------------------------------------------------

Se tiene que añadir algo de código (para emular la propiedad OpenArgs del informe):

Private Sub Report_Open(Cancel As Integer)
If Temp_Condicion <> "" Then Me.Filter = Temp_Condicion: Me.FilterOn = True
End Sub

Y ahora el experimento:

Paso uno: darle contenido a la variable (la condicion que ya se esta utilizando)

Temp_Condicion = "Codigo = " & Me.Codigo

Paso dos: enviarlo, en lugar de  'Me.Codigo' un codigo conocido en lugar de  ([email protected]) mejor pon el que utilices para que veas lo que se envía:

-----------------------------------------------------------------------------

Cuando la variable 'Temp_Condicion' deje de utilizarse:

Temp_Condicion = ""

Y el informe funcionara como si no existiese y cuando tenga un filtro asumible en Temp_Condicion lo aplicara.

Respuesta

Le dejo esta alternativa con Outllook

Sub EnviarCorreosAdjuntos()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim appOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim codigoAnterior As String
    Dim adjuntos As String
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT Codigo, NPdf, Imprimir, Trabajador, Correo FROM I_MAYOR ORDER BY Codigo")
    Set appOutlook = New Outlook.Application
    Set msg = appOutlook.CreateItem(olMailItem)
    codigoAnterior = ""
    Do While Not rs.EOF
        Dim codigo As String
        Dim npdf As String
        Dim imprimir As Boolean
        Dim trabajador As String
        Dim correo As String
        codigo = rs!codigo
        npdf = rs!npdf
        imprimir = rs!imprimir
        trabajador = rs!trabajador
        correo = rs!correo
        If codigo <> codigoAnterior Then
            ' Enviar correo anterior y reinicializar el mensaje
            If codigoAnterior <> "" Then
                ' Adjuntar los archivos del grupo anterior
                msg.Attachments.Add adjuntos
                msg.Send
                Set msg = appOutlook.CreateItem(olMailItem)
            End If
            codigoAnterior = codigo
            ' Configurar el nuevo correo
            With msg
                .Subject = "Adjuntos para el código " & codigo
                .Body = "Adjuntos relacionados con el código " & codigo & vbCrLf & vbCrLf
                .To = correo
            End With
            ' Exportar informe a PDF
            DoCmd.OutputTo acOutputReport, "I_MAYOR", acFormatPDF, "C:\INF\" & npdf & ".PDF"
            ' Adjuntar el archivo PDF al correo
            adjuntos = "C:\INF\" & npdf & ".PDF"
        Else
            ' Exportar informe a PDF
            DoCmd.OutputTo acOutputReport, "I_MAYOR", acFormatPDF, "C:\INF\" & npdf & ".PDF"
            ' Adjuntar el archivo PDF al correo
            adjuntos = adjuntos & ";" & "C:\INF\" & npdf & ".PDF"
        End If
        rs.MoveNext
    Loop
    ' Adjuntar los archivos del último grupo
 msg. Attachments. Add adjuntos
    ' Enviar el último correo
    Msg. Send
    ' Liberar recursos
    Rs. Close
    Set rs = Nothing
    Set db = Nothing
    Set msg = Nothing
    Set appOutlook = Nothing
End Sub

Debe ajustar la ruta de almacenamiento. Puede cambiar el SQL de esta línea por el nombre de su consulta.

Set rs = db.OpenRecordset("SELECT Codigo, NPdf, Imprimir, Trabajador, Correo FROM I_MAYOR ORDER BY Codigo")

Algo como

Set rs = db.OpenRecordset("miConsulta")

Cambie miConsulta por en nombre de su consulta.

Buenas tardes Eduardo, como siempre gracias por tu ayuda, nada más empezar me da error en

 Dim appOutlook As Outlook.Application

Que estoy haciendo mal

Falta la referencia a Outlook

  1. Abra el Editor de Visual Basic en Access presionando Alt + F11.
  2. En el menú superior, selecciona "Herramientas" y luego "Referencias".
  3. En la lista de referencias disponibles, busque y marque la opción "Microsoft Outlook XX.X Object Library" (donde "XX.X" es la versión de Outlook instalada en su sistema). Asegúrese de seleccionar la versión correcta.
  4. Haga clic en "Aceptar" para guardar los cambios y cerrar la ventana de referencias.

Eduardo funciona, tan solo que he observado que cuando genera el informe temporal lo hace con todos los registros, unas 1000 páginas aunque cuando envía el informe lo hace de forma correcta y filtrado pero en la elaboración tarda mucho tiempo y ralentiza todo el proceso, hay alguna forma de minimizar el tiempo

Para minimizar el tiempo de generación del informe temporal, puede hacer uso de la función OutputTo para exportar directamente los informes a archivos PDF sin necesidad de abrirlos en la pantalla. Esto evitará el tiempo de renderizado y acelerará el proceso. Además, puede utilizar un objeto Collection para almacenar los nombres de los archivos adjuntos en lugar de concatenarlos en una cadena. Le dejo el código

Sub EnviarCorreosAdjuntos()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim appOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim codigoAnterior As String
    Dim adjuntos As Collection
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT Codigo, NPdf, Imprimir, Trabajador, Correo FROM I_MAYOR ORDER BY Codigo")
    Set appOutlook = New Outlook.Application
    Set msg = appOutlook.CreateItem(olMailItem)
    Set adjuntos = New Collection
    codigoAnterior = ""
    Do While Not rs.EOF
        Dim codigo As String
        Dim npdf As String
        Dim imprimir As Boolean
        Dim trabajador As String
        Dim correo As String
        codigo = rs!codigo
        npdf = rs!npdf
        imprimir = rs!imprimir
        trabajador = rs!trabajador
        correo = rs!correo
        If codigo <> codigoAnterior Then
            ' Enviar correo anterior y reinicializar el mensaje
            If codigoAnterior <> "" Then
                ' Adjuntar los archivos del grupo anterior
                For Each adjunto In adjuntos
                    msg.Attachments.Add adjunto
                Next adjunto
                msg.Send
                Set msg = appOutlook.CreateItem(olMailItem)
                adjuntos.Clear
            End If
            codigoAnterior = codigo
            ' Configurar el nuevo correo
            With msg
                .Subject = "Adjuntos para el código " & codigo
                .Body = "Adjuntos relacionados con el código " & codigo & vbCrLf & vbCrLf
                .To = correo
            End With
            ' Exportar informe a PDF
            DoCmd.OutputTo acOutputReport, "I_MAYOR", acFormatPDF, "C:\INF\" & npdf & ".PDF"
            ' Adjuntar el archivo PDF al correo
            adjuntos.Add "C:\INF\" & npdf & ".PDF"
        Else
            ' Exportar informe a PDF
            DoCmd.OutputTo acOutputReport, "I_MAYOR", acFormatPDF, "C:\INF\" & npdf & ".PDF"
            ' Adjuntar el archivo PDF al correo
            adjuntos.Add "C:\INF\" & npdf & ".PDF"
        End If
        rs.MoveNext
    Loop
    ' Adjuntar los archivos del último grupo
    For Each adjunto In adjuntos
        msg.Attachments.Add adjunto
    Next adjunto
    ' Enviar el último correo
    msg.Send
    ' Liberar recursos
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set msg = Nothing
    Set appOutlook = Nothing
End Sub

Hola Eduardo me da un error

Le suministro este en donde en lugar de usar adjuntos.Clear, debe usar Set adjuntos = New Collection para reinicializar la colección.

Sub EnviarCorreosAdjuntos()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim appOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim codigoAnterior As String
    Dim adjuntos As Collection
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT Codigo, NPdf, Imprimir, Trabajador, Correo FROM I_MAYOR ORDER BY Codigo")
    Set appOutlook = New Outlook.Application
    Set msg = appOutlook.CreateItem(olMailItem)
    Set adjuntos = New Collection
    codigoAnterior = ""
    Do While Not rs.EOF
        Dim codigo As String
        Dim npdf As String
        Dim imprimir As Boolean
        Dim trabajador As String
        Dim correo As String
        codigo = rs!codigo
        npdf = rs!npdf
        imprimir = rs!imprimir
        trabajador = rs!trabajador
        correo = rs!correo
        If codigo <> codigoAnterior Then
            ' Enviar correo anterior y reinicializar el mensaje
            If codigoAnterior <> "" Then
                ' Adjuntar los archivos del grupo anterior
                For Each adjunto In adjuntos
                    msg.Attachments.Add adjunto
                Next adjunto
                msg.Send
                Set msg = appOutlook.CreateItem(olMailItem)
                Set adjuntos = New Collection ' Reinicializar la colección de adjuntos
            End If
            codigoAnterior = codigo
            ' Configurar el nuevo correo
            With msg
                .Subject = "Adjuntos para el código " & codigo
                .Body = "Adjuntos relacionados con el código " & codigo & vbCrLf & vbCrLf
                .To = correo
            End With
            ' Exportar informe a PDF
            DoCmd.OutputTo acOutputReport, "I_MAYOR", acFormatPDF, "C:\INF\" & npdf & ".PDF"
            ' Adjuntar el archivo PDF al correo
            adjuntos.Add "C:\INF\" & npdf & ".PDF"
        Else
            ' Exportar informe a PDF
            DoCmd.OutputTo acOutputReport, "I_MAYOR", acFormatPDF, "C:\INF\" & npdf & ".PDF"
            ' Adjuntar el archivo PDF al correo
            adjuntos.Add "C:\INF\" & npdf & ".PDF"
        End If
        rs.MoveNext
    Loop
    ' Adjuntar los archivos del último grupo
    For Each adjunto In adjuntos
        msg.Attachments.Add adjunto
    Next adjunto
    ' Enviar el último correo
    msg.Send
    ' Liberar recursos
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set msg = Nothing
    Set appOutlook = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas