Tengo un problema con esta macros quiero que me copie más de una firma en el cuerpo de un correo (Outlook)

Hola señor dante quisiera que me ayude tengo esta macros que me copia la primera foto en el cuerpo del mensaje del outlook . "sti_1.jpg"

.Attachments.Add "C:\Users\Edwin\Desktop\Nueva carpeta\sti_1.jpg"

pero la segunda imagen me lo adjunta como un archivo en el correo : "sti_2.jpg""

.Attachments.Add "C:\Users\Edwin\Desktop\Nueva carpeta\sti_2.jpg"

y quiero q me siga copiando mas imagenes en el cuerpo del mensaje .

Sub OutlookMailExcel()
Dim OutApp As Object
Dim OutMail As Object
'Outlook
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
'Crea el correo
Set OutMail = OutApp.createitem(0)
ActiveWorkbook.Save
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "[email protected]"
.To = "[email protected]"
.Subject = "Correo de prueba"
'Archivo de imagen que contiene la firma
.Attachments.Add "C:\Users\Edwin\Desktop\Nueva carpeta\sti_1.jpg"
.Attachments.Add "C:\Users\Edwin\Desktop\Nueva carpeta\sti_2.jpg"
.BodyFormat = 2 'olFormatHTML
.HTMLBody = "<html>" & _
"<body>" & _
"<p>Aquí va el mensaje que deseas enviar...</p>" & _
"<br>" & _
"<br>" & _
"<br>" & _
"<img src='cid:'" & .Attachments.Item(1).Filename & "' height=720 width=850>" & _
"<br>" & _
"</body>" & _
"</html>"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

1 respuesta

Respuesta
1

Te anexo la macro con los cambios, ya la probé y me pone las 2 imágenes en el cuerpo del correo.

Sub OutlookMailExcel()
Dim OutApp As Object
Dim OutMail As Object
Dim ultFil As Long
Dim i As Long
'Ultima fila usada
ultFil = Range("H:H").Find("*", , , , , xlPrevious).Row
'Outlook
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
'Bucle para enviar emails
For i = 2 To ultFil
    If Cells(i, "B") <> Empty Then
        'Crea el correo
        Set OutMail = OutApp.createitem(0)
        'ActiveWorkbook.Save
        On Error Resume Next
        With OutMail
            .SentOnBehalfOfName = "[email protected]"
            .To = Cells(i, "B").Value
            .Subject = "Correo de prueba"
            'Archivo de imagen que contiene la firma
            ruta = "C:\Users\Edwin\Desktop\Nueva carpeta\"
            .Attachments.Add ruta & "sti_2.jpg"
            .Attachments.Add ruta & "sti_1.jpg"
            .BodyFormat = 2 'olFormatHTML
            .HTMLBody = "<html>" & _
            "<body>" & _
            "<p>Aquí va el mensaje que deseas enviar...</p>" & _
            "<br>" & _
            "<br>" & _
            "<br>" & _
            "<img src=cid:sti_1.jpg height=720 width=850>" & _
            "<img src=cid:sti_2.jpg height=720 width=850>" & _
            "</body>" & _
            "</html>"
            .Display
        End With
    End If
Next i
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

¡Gracias!  señor dante me ayudo mucho su respuesta en verdad le agradezco por haberme tomado un unos minutos de su tiempo para ayudarme ,muchas gracias 

Añade tu respuesta

Haz clic para o
El autor de la pregunta ya no la sigue por lo que es posible que no reciba tu respuesta.

Más respuestas relacionadas