Enviar Email con formato de la celda de Excel
Tengo esta macro para enviar Email pero necesito que el dato de la celda que paso sea con el el formade la misma ya que solo pasa el texto, me pueden ayudar
Sub Mail_Outlook_With_Signature_Html_1()
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim strbody1 As String
Dim FechLim As String
Dim strbody2 As String
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<H2><B>Estimado(a).</B></H2>"
'Range ("M" & i) Contacto
'FechLim1 = Range("F" & i).PasteSpecial Paste:=8
' Range("F" & i).Copy
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:</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>"
On Error Resume Next
With OutMail
.Display
.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 " & Range("N" & i) & " ASEGURADORA " & Range("O" & i) & "POLIZA " & Range("P" & i) & " IMPORTE " & Range("Q" & i) & "<br>" & strbody2 & .HTMLBody
.Display
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then .Attachments.Add archivo
Next
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Next
MsgBox "Correos enviados", vbInformation, "