Copiar tabla de un excel en el cuerpo de un correo de Outlook

Antes que nada comentaros que os leo mucho y ahora me he animado a participar y poder ayudar en todo lo posible.

Primeramente os quiero plantear un problemilla que tengo y es que quiero generar a traves de Excel un correo.

Consigo generar el correo, escribir un texto pero me falta adjuntar en el cuerpo del mensaje una tabla que tengo en el excel. Esa tabla va variando de filas y serán varias.

El mensaje lo escribo en código html.

Hasta ahora lo que tengo es lo siguiente:

Sub enviar_correo()
Application.ScreenUpdating = False
Application.Wait (Now + TimeValue("00:00:01"))
Dim tabla_alta_sello As String
Dim OutApp As Object
Dim Outmail As Object
Set AppOutlook = Nothing
On Error Resume Next
Do While True
    Set AppOutlook = CreateObject("outlook.application")
    If Not AppOutlook Is Nothing Then
        Exit Do
    End If
    Loop
    On Error GoTo 0
Application.Wait (Now + TimeValue("00:00:01"))
Set OutApp = CreateObject("Outlook.Application")
Application.Wait (Now + TimeValue("00:00:01"))
Set Outmail = OutApp.createitem(0)
Dim MensajeHTML As Variant
Dim Tabla As Variant
With Outmail
        Sheets("Preparar correo").Select
        Range("A2:D3").Select
        'Set tabla_alta_sello = Range("A2:D3")
      MensajeHTML = "<span style='font: 13px verdana;'>" & _
    " Buenos días," & _
    "
Se ha producido una nueva actualización de la lista de sellos a la que podéis acceder en el servidor FTP" & _
    "
Los cambios producidos han sido:" & _
'AQUÍ DEBERIAN DE IR LAS TABLAS
     "
Gracias y saludos." & _
    "</span>"
.display
.To = ""
.cc = ""
.Bcc = ""
.Subject = Format(Now(), "yymmdd") & " Listado de sellos actualizado"
.HTMLBody = MensajeHTML & .HTMLBody & strbody
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
Sheets("Actualizaciones").Select
End Sub

1 Respuesta

Respuesta
1

En esta respuesta he armado una tabla en html

¿Cómo envío correo automático confirmando solicitud por formulario Excel, prog en Visual Basic?

En esta línea de la macro establezco el rango de la tabla:

Set r = hoja.Range("A" & fila & ":U" & fila)

Puedes cambiar el rango por el nombre de la tabla, por ejemplo:

Sub EnviarCorreo()
'Por.Dante Amor
    Set hoja = ActiveSheet
    Set dam = CreateObject("outlook.application").createitem(0)
    dam.To = ""
    dam.Subject = ""
    '
    cuerpo = "Correo automático"
    Set r = hoja.Range("Tabla1")
    fini = r.Cells(1, 1).Row
    ffin = fini + r.Rows.Count - 1
    cini = r.Cells(1, 1).Column
    cfin = cini + r.Columns.Count - 1
    tabla = "<table border><tr>"
    For i = fini To ffin
        For j = cini To cfin
            tabla = tabla & "<td>" & hoja.Cells(i, j) & "</td>"
        Next
        tabla = tabla & "</tr>"
    Next
    tabla = tabla & "</table>"
    dam.HTMLBody = _
        "<HTML> " & _
            "<BODY>" & _
                "<P>" & cuerpo & tabla & "</P>" & _
            "</BODY> " & _
        "</HTML>"
    'dam. Send 'El correo se envía en automático
    dam.Display  'El correo se muestra
End Sub

Si la tabla tiene encabezado en esta línea resta menos 1

fini = r.Cells(1, 1).Row - 1

Sigue el mismo código para crear la tabla2, tabla3, etc

    Set r = hoja.Range("Tabla1")
    fini = r.Cells(1, 1).Row
    ffin = fini + r.Rows.Count - 1
    cini = r.Cells(1, 1).Column
    cfin = cini + r.Columns.Count - 1
    tabla = "<table border><tr>"
    For i = fini To ffin
        For j = cini To cfin
            tabla = tabla & "<td>" & hoja.Cells(i, j) & "</td>"
        Next
        tabla = tabla & "</tr>"
    Next
    tabla = tabla & "</table>"

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

¡Gracias! 

Mañaana lo probaré en el trabajo,

Muchas gracias, te responderé.

Saludos!

Buenas,

Antes que nada te agradezco tu ayuda.

Comentarte que me da error en la siguiente línea:

tabla = tabla & "<td>" & hoja.Cells(i, j) & "</td>"

Mi código tiene la siguiente forma:

Sub enviar_correo()
Set hoja = Sheets("Preparar correo")
Application.ScreenUpdating = False
Application.Wait (Now + TimeValue("00:00:01"))
Dim tabla_alta_sello As String
Dim OutApp As Object
Dim Outmail As Object
Dim tabla As Range
Set AppOutlook = Nothing
On Error Resume Next
Do While True
    Set AppOutlook = CreateObject("outlook.application").createitem(0)
    If Not AppOutlook Is Nothing Then
        Exit Do
    End If
    Loop
    On Error GoTo 0
Application.Wait (Now + TimeValue("00:00:01"))
Set OutApp = CreateObject("Outlook.Application")
Application.Wait (Now + TimeValue("00:00:01"))
Set Outmail = OutApp.createitem(0)
Dim MensajeHTML As Variant
With Outmail
        Set r = hoja.Range("Tabla10")
    fini = r.Cells(1, 1).Row - 1
    ffin = fini + r.Rows.Count - 1
    cini = r.Cells(1, 1).Column
    cfin = cini + r.Columns.Count - 1
    tabla = "<table border><tr>"
    For i = fini To ffin
        For j = cini To cfin
            tabla = tabla & "<td>" & hoja.Cells(i, j) & "</td>"
        Next
        tabla = tabla & "</tr>"
    Next
    tabla = tabla & "</table>"
    MensajeHTML = "<span style='font: 13px verdana;'>" & _
    " Buenos días," & _
    "
Se ha producido una nueva actualización de la lista de sellos a la que podéis acceder en el servidor FTP de MAVE en la siguiente ruta: " & _
    "
/SISTEMAS-CALIDAD/SG Calidad/PC-751 Control, identificación y trazabilidad/Registros" & _
    "
Los cambios producidos han sido:" & _
    "<P>" & tabla & "</P>" & _
     "
Gracias y saludos." & _
    "</span>"
.display
.To = ""
.cc = ""
.Bcc = ""
.Subject = Format(Now(), "yymmdd") & " Listado de sellos actualizado"
.HTMLBody = MensajeHTML & .HTMLBody & strbody
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
Sheets("Actualizaciones").Select
End Sub

Perdón, la línea donde me da error es la siguiente:

tabla = "<table border><tr>"

Gracias

La variable tabla no es un rango, es un string

La declaraste así:

Dim tabla As Range

Debe ser así:

Dim tabla As String

En VBA no es necesario declarar variables. La macro funcionaría si no hubieras declarado las variables.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Gracias!!!

Y por último, sabrías como podría poner la tabla con el siguiente formato?

Ahora aparece uno muy básico.

Muchas gracias

Tienes que modificar los colores y los estilos en HTML

Con mucho gusto te ayudo con todas tus peticiones.

Valora esta respuesta y crea una nueva pregunta en el tema de microsoft Excel. En el desarrollo de la pregunta escribe: "para Dante Amor". Ahí me describes con detalle lo que necesitas.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas