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
1

H o l a:

Puedes explicar "solo quiero mostrar en el cuerpo del correo los 5 o 10 primeros"

Si puedes poner ejemplos de lo que tienes y de esos ejemplos qué es lo que quieres enviar.

  1. Hay una serie de documentos con fecha de vencimiento, de los cuales solo quiero que en el correo se muestren solo 10.
  2. 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?
  1. 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.
  2. ¿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 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas