Enviar correo mediante excel , con un rango de celdas.
Tengo N documentos con vencimiento de las cuales solo quiero mostrar en el cuerpo del correo los 5 o 10 primeros, he avanzado lo siguiente:
Private Sub Workbook_Open()
Sheets("ORDEN").Select
ufila = Range("B" & Rows.Count).End(xlUp).Row
For i = 4 To ufila
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
Range("D3:G14").Copy
para = Cells(i, 10) & ";" & Cells(i, 11) & ";" & Cells(i, 12)
parte2.to = para 'Destinatarios
'parte2.CC = "" 'Con copia
parte2.Subject = "prueba" '"Asunto"
'"Cuerpo del mensaje"
Parte2. Body = "Señores a continuacion listado de cartas fianzas por vencer "
'parte2. Attachments.Add Ruta & Archivo
Parte2. Send 'El correo se envía en automático
'parte2. Display 'El correo se muestra
Next
End Sub
1 Respuesta
Respuesta de Dante Amor
1
- Hay una serie de documentos con fecha de vencimiento, de los cuales solo quiero que en el correo se muestren solo 10.
- Tuve que crear una hoja "ORDEN" donde muestran los 12 primeros documentos con próximos vencimientos, ya que cuando ingresan los datos a la hoja de excel, lo ingresan por orden de llegada y por ende vence después que los que se ingresaron o digitaron primero. ¿Hay forma de que la macro me lo ordene sin tener que crear esa hoja y lo envíe al correo ordenado?
- Cada documento tiene un código, pero sin embargo muchas de ellas vencen la misma fecha, pero también quiero que por cada fecha se muestre el código de la carta y el monto ya que por excel me jalará el primer dato de la fecha y si hay 5 fechas iguales en vencimiento me jalará un solo valor y sera repetitivo.
- ¿TE puedo enviar mi archivo?
¡Gracias!
Envíame un archivo de excel y me explicas claramente cuáles registros van en el correo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “RICHARD CAMPUSMANA” y el título de esta pregunta.
Hola Dante acabo de enviarlo.
¡Gracias!
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 SubSub 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 Subsal u dos
