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 de Dante Amor
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 SubSub 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 SubSub 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
