Te anexo 2 macros una para enviar el correo en formato html y la otra para enviarlo como imagen:
Sub EnviarCorreo()
'Por.Dante Amor
Set h1 = Sheets("CONSOLIDADO")
Set h2 = Sheets("ORDEN")
Set h3 = Sheets("correos")
'
h2.Cells.Clear
h2.Cells(1, "A") = "Nº"
h2.Cells(1, "B") = "F.V."
h2.Cells(1, "C") = "CIUDAD"
h2.Cells(1, "D") = "GRUPO"
h2.Cells(1, "E") = "Nº FIANZA"
h2.Cells(1, "F") = "MONTO"
j = 2
n = 1
'
For i = 5 To h1.Range("F" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "F") > Date Then
h2.Cells(j, "A") = n
h2.Cells(j, "B") = h1.Cells(i, "F")
h2.Cells(j, "C") = h1.Cells(i, "A")
h2.Cells(j, "D") = h1.Cells(i, "B")
h2.Cells(j, "E") = h1.Cells(i, "C")
h2.Cells(j, "F") = h1.Cells(i, "G")
n = n + 1
j = j + 1
End If
Next
'
u = h2.Range("B" & Rows.Count).End(xlUp).Row
If u > 2 Then
With h2.Sort
.SortFields.Clear
.SortFields.Add Key:=h2.Range("B2:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h2.Range("B1:F" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
'
h2.Columns("B:B").NumberFormat = "m/d/yyyy"
h2.Cells.EntireColumn.AutoFit
h2.Columns("F:F").NumberFormat = "[$S/.-280A] #,##0.00"
'
Set r = h2.Range("A1:F13")
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h3.[A2] & ";" & h3.[A3] & ";" & h3.[A4] 'Destinatarios
dam.Subject = "Prueba en html"
cuerpo = "Envío de correo automático sobre vencimientos de Carta fianza, a continuación record de 12 primeras cartas por vencerse"
'
f = r.Rows.Count
c = r.Columns.Count
tabla = "<table border><tr>"
For i = 1 To r.Rows.Count
For j = 1 To r.Columns.Count
If j = 6 Then
tabla = tabla & "<td>" & Format(r.Cells(i, j), """S/."" #,##0.00") & "</td>"
Else
tabla = tabla & "<td>" & r.Cells(i, j) & "</td>"
End If
Next
tabla = tabla & "</tr>"
Next
tabla = tabla & "</table>"
'
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & cuerpo & tabla & "</P>" & _
"</BODY> " & _
"</HTML>"
Dam. Display 'El correo se muestra
Dam. Send
Set dam = Nothing
'
'MsgBox "fin"
End Sub
Sub EnviarCorreoConImagen()
'Por.Dante Amor
Set h1 = Sheets("CONSOLIDADO")
Set h2 = Sheets("ORDEN")
Set h3 = Sheets("correos")
'
h2.Cells.Clear
h2.Cells(1, "A") = "Nº"
h2.Cells(1, "B") = "F.V."
h2.Cells(1, "C") = "CIUDAD"
h2.Cells(1, "D") = "GRUPO"
h2.Cells(1, "E") = "Nº FIANZA"
h2.Cells(1, "F") = "MONTO"
j = 2
n = 1
'
For i = 5 To h1.Range("F" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "F") > Date Then
h2.Cells(j, "A") = n
h2.Cells(j, "B") = h1.Cells(i, "F")
h2.Cells(j, "C") = h1.Cells(i, "A")
h2.Cells(j, "D") = h1.Cells(i, "B")
h2.Cells(j, "E") = h1.Cells(i, "C")
h2.Cells(j, "F") = h1.Cells(i, "G")
n = n + 1
j = j + 1
End If
Next
'
u = h2.Range("B" & Rows.Count).End(xlUp).Row
If u > 2 Then
With h2.Sort
.SortFields.Clear
.SortFields.Add Key:=h2.Range("B2:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h2.Range("B1:F" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
'
h2.Columns("B:B").NumberFormat = "m/d/yyyy"
h2.Cells.EntireColumn.AutoFit
h2.Columns("F:F").NumberFormat = "[$S/.-280A] #,##0.00"
'
h2.Range("A1:F13").CopyPicture
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h3.[A2] & ";" & h3.[A3] & ";" & h3.[A4] 'Destinatarios
dam.Subject = "Prueba con imagen"
dam.Body = "Envío de correo automático sobre vencimientos de Carta fianza, a continuación record de 12 primeras cartas por vencerse"
dam.Display 'El correo se muestra
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{END}", True
DoEvents
SendKeys "^v", True
DoEvents
dam.Send
Set dam = Nothing
'
'MsgBox "fin"
End Sub
sal u dos