Envia Email desde excel copiando celdas con formato y adjuntando archivo
Dante tome una macro que creo que tu realizaste y la estoy modificando pero no puedo pegar unas celdas con formato y en un lugar especifico del cuerpo del correo me puedes ayudas
A que email te puedo enviar la macro que modifique y la muestra de como necesito que quede el Email
1 Respuesta
Respuesta de Dante Amor
2
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario "victor paramo" y el título de esta pregunta.
Ya lo mande dante Muchas gracias espero me puedas ayudar tu macro es bastante buena y la quiero adaptar a mis necesidades
Te anexo la macro con los formatos.
Sub Mail_Outlook_With_Signature_Html_1()
'Por.Dante Amor
Cells.Rows.Hidden = False
For i = 2 To 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>"
If i > 2 Then Rows(i - 1).Hidden = True
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 & strbody1 & FechLim & strbody2
Range("M1:R1,M" & i & ":R" & i).Copy
DoEvents
.display
DoEvents
SendKeys "^{Home}"
DoEvents
SendKeys "{Down}"
DoEvents
SendKeys "{Down}"
DoEvents
SendKeys "{Down}"
DoEvents
SendKeys "{Down}"
DoEvents
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
DoEvents
Next
.display
DoEvents
End With
Next
Cells.Rows.Hidden = False
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End SubAl final de mi respuesta dice: “Es una buena respuesta” y puedes seleccionar una de 3 opciones:
- Excelente
- Si
- No
Saludos. Dante Amor
No olvides valorar la respuesta.
