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 Respuesta
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
