Como puedo enviar un correo masivo con adjunto e imagen de firma en cuerpo de correo?

Estoy intentando mandar correos masivos. Ya usé tu aplicación pero ahora quiero adjuntar una imagen y la firma en cuerpo de correo.

¿Me ayudas?

1

1 Respuesta

4.704.900 pts. Sancho, si los perros ladran ...

Revisa las siguientes respuestas, ahí explico cómo poner la imagen y la firma

Macro envío de libro excel por correo con firma

No olvides votar y regresar a valorar la respuesta.

Muchas Gracias por tu respuesta. 

Actualmente uso esta macro que saque de alguna de tus respuestas. 

'***Macro Para enviar correos
Sub correo()
'Base
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
dam.body = Range("F" & i) '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then dam.Attachments.Add archivo
Next
dam.send 'El correo se envía en automático
'dam.display 'El correo se muestra
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

A esto le quiero agregar el poder meter una imagen en cuerpo de correo. 

Espero me puedas ayudar. no soy muy experto en excel. 

Revisa las respuestas, ahí explico cómo poner la imagen y la firma

Gracias. Estoy usando este código. 

Sub correo()
'Por.Dante Amor
col = Range("H1").Column
ruta = ThisWorkbook.Path & "\"
For i = 3 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
Cuerpo = Range("F" & i) '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then dam.Attachments.Add archivo
Next
'
logo = "C:\Users\luis.perez\Pictures\BIENVENIDA.png.jpg"
dam.Attachments.Add ruta & logo
dam.htmlbody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & Cuerpo & "</P>" & _
"<img src=cid:" & logo & " height=40 width=40>" & _
"<br>" & "<b>" & [I2] & "</b>" & _
"<br>" & [J2] & _
"<br>" & [K2] & _
"</BODY> " & _
"</HTML>" & dam.htmlbody
'dam.Display 'El correo se muestra
dam.send 'El correo se envía en automático
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Pero no me manda mails. 

¿Tienes datos en la columna B?

Puedes ejecutar la macro con F8, es decir, paso a paso y me comentas qué hace.

HOla, si tengo datos en la columna B. No me aparecen errores ni mensajes. Me aparece el mensaje al final de correos enviados pero no manda nada. Espero me puedas ayudar

Ejecutaste la macro paso por paso

Entras a esta línea:

dam.htmlbody = _

Ya la ejecute paso a paso y no me da. 

Parece ejecutarse bien pero no se manda ningún correo. 

Sub correo()
'Por.Dante Amor
col = Range("H1").Column
ruta = ThisWorkbook.Path & "\"
For i = 3 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
Cuerpo = Range("F" & i) '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then dam.Attachments.Add archivo
Next
'
logo = "C:\Users\luis.perez\Pictures\BIENVENIDA.png.jpg"
dam.Attachments.Add ruta & logo
dam.htmlbody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & Cuerpo & "</P>" & _
"<img src=cid:" & logo & " height=40 width=40>" & _
"<br>" & "<b>" & [I2] & "</b>" & _
"<br>" & [J2] & _
"<br>" & [K2] & _
"</BODY> " & _
"</HTML>" & dam.htmlbody
'dam.Display 'El correo se muestra
dam.send 'El correo se envía en automático
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Ya pude con este código pero el archivo que seleccioné para que esté en cuerpo de correo aparece como adjunto. 

Sub correo()
'Por.Dante Amor
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
dam.body = Range("F" & i) '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then dam.Attachments.Add archivo
Next
'
logo = "C:\Users\luis.perez\Pictures\BIENVENIDA.png.jpg"
dam.Attachments.Add ruta & logo
dam.htmlbody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & Cuerpo & "</P>" & _
"<img src=cid:" & logo & " height=40 width=40>" & _
"<br>" & "<b>" & [I2] & "</b>" & _
"<br>" & [J2] & _
"<br>" & [K2] & _
"</BODY> " & _
"</HTML>" & dam.htmlbody
'dam.Display 'El correo se muestra
dam.send 'El correo se envía en automático
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Me aparece esta imagen en cuerpo de correo

Revisa bien el archivo de tu logo

C:\Users\luis.perez\Pictures\BIENVENIDA.png.jpg

Le pusiste 2 extensiones: .png y .jpg, revisa cuál es la que tiene el archivo

Gracias por tu respuesta. 

El archivo tiene el nombre como Bienvenida.png y la extensión es jpg. 

Ya probé con otro archivo y no jala. me hace lo mismo.

Saludos

¿Y ya lo corregiste en el código?

Entonces puede ser tu versión de office

Yo tengo 2007 y también lo he probado con la 2010 y funciona

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas