Macro con distintos destinatarios, asuntos, adjunto y cuerpo de mensaje con tabla (HTML) distinto para c/u

Hola Dante,

Encontré tu macro de enviar varios correos a varios destinatarios, distintos cuerpos de mensajes, asuntos y distintos archivos adjuntos. He querido darle aun mayor complejidad a la que ya tiene y agregarle en el cuerpo del mensaje de cada correo, un mensaje + una tabla pequeña de excel.  Hasta donde entiendo hay que convertir el mensaje en HTML y no he conseguido como hacerlo. Por favor, me podrías ayudar?

1 respuesta

Respuesta
1

Te anexo unas macros que tengo para enviar correo con html, revísalos y trata de adaptar el código a lo que necesitas.

Private Sub CommandButton1_Click()
'Por.Dante Amor
    If TextBox1 = "" Then
        MsgBox "El textbox está vacío, favor de llenar el destinatario"
        Exit Sub
    End If
    If ComboBox1 = "" Then
        MsgBox "El combo está vacío, favor de llenar"
        Exit Sub
    End If
    '
    Set dam = CreateObject("outlook.application").createitem(0)
    ActiveWorkbook.Save
    probando1 = Range("A2")
    probando2 = Range("B2")
    probando3 = Range("C2")
    probando4 = Range("D2")
    With dam
        .To = TextBox1
        .CC = ""
        .BCC = ""
        .Subject = "Reporte " & ComboBox1
        .BodyFormat = 2
        .HTMLBody = "<HTML> " & _
        "<BODY>" & _
        "<P>" & "Se ha reportado un evento  asignándole el código " & codigofolio & ", favor completar la siguiente tabla:" & "</P>" & _
        "<table border>" & "<tr> <th> fechaocurre </th> <th>valor2</th> <th>valor3</th> <th>valor4</th> </tr>" & _
        "<tr> <td>" & _
        probando1 & "</td> <td>" & _
        probando2 & "</td> <td>" & _
        probando3 & "</td> <td>" & _
        probando4 & "</td> </tr>" & "</table>" & _
        "<P>" & "Saludos," & "</P>" & _
        "</BODY> " & _
        "</HTML>"
        .Display
    End With
    Set dam = Nothing
End Sub

Sub enviar()
'Por.Dante Amor
    For i = 3 To 3
        If A = A Then
            Set dam = CreateObject("outlook.application").createitem(0)
            dam.To = "damor" '"[email protected]"
            dam.Subject = "Asunto"
            dam.htmlBody = _
                "Buen día!!! <br>" & _
                "Lic. maritnez por medio de la presente le recuerdo el envío del <br>" & _
                "<b>xxxxxxxxxxxxxxxxx.</b><br>" & _
                "Día de Operación <b><span style=""color:#FF0000"">" & Cells(i, "A") & "</b></span style>" & _
                ". Este reporte se le debe enviar a la xxxxxxxxxxxxxx " & _
                "y el envío tiene como fecha y hora límite el día <b><span style=""color:#FF0000"">" & Cells(i, "B") & "</b></span style>" & _
                " antes de las 02:00 p.m. correspondiente al xxxxxxxxxxxxxxxxxxxxxxxxxxxx. <br>" & _
                "Gracias!!"
            'dam.htmlBody = "Part 1<br>" _
                    & "<b>Part 2</b><br>" _
                    & "Part 3"
            dam.display
            'dam.display 'El correo se muestra
        End If
    Next
End Sub

Sub Mail_Outlook_With_Signature_Html_1()
'Por.Dante Amor
    For i = 2 To 2 'Range("B" & Rows.Count).End(xlUp).Row
        Set dam = CreateObject("Outlook.Application").CreateItem(0)
        strbody = "<H2><B>Estimado(a).</B></H2>"
        strbody1 = "<H3><B>Con la finalidad de que puedan programar los pagos y evitar contratiempos, envió los recibos de pago a vencer, favor de hacer los pagos antes de la fecha de vencimiento para evitar quedar desprotegidos.</B></H3>"
        FechLim = "<H3><B>Fecha Limite:________Asegurado_______Auto________Aseguradora________Poliza           IMPORTE </B></H3>"
        strbody2 = "<H3><B>Si ya fue realizado favor de hacer caso omiso y favor de mandar una copia del pago para cualquier aclaración.</B></H3>" & _
                  "Cualquier duda quedo a tus ordenes.<br>" & _
                  "<A HREF=""[email protected]"">[email protected]</A>" & _
                  "<br><br><B>Favor de Confirmar la Recepcion</B>"
        With dam
            .To = Range("B" & i) 'Destinatarios
            .CC = Range("C" & i) 'Con copia
            .BCC = Range("D" & i) 'Con copia oculta
            .Subject = Range("E" & i) '"Asunto"
            .HTMLBody = strbody & Range("M" & i) & strbody1 & FechLim & Range("F" & i) & "<br>" & " RAMO " & Dato1 & " ASEGURADORA " & Range("O" & i) & "POLIZA " & Range("P" & i) & " IMPORTE " & Range("Q" & i) & "<br>" & strbody2
            Range("N" & i, "Q" & i).Copy
            .display
            SendKeys "{Down}"
            SendKeys "{Down}"
            SendKeys "{Down}"
            SendKeys "{Down}"
            SendKeys "^v"
            DoEvents
            .display
            For j = Range("H1").Column To Range("L1").Column
                If Cells(i, j).Value <> "" Then .Attachments.Add Cells(i, j).Value
            Next
            .display
        End With
    Next
    MsgBox "Correos enviados", vbInformation, "
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas