Macro para envíar correos masivos con adjuntos diferentes
Pido su ayuda para generar una Macro en Excel que pueda enviar correos masivos con archivos adjuntos diferentes, es decir al correo [email protected] se le enviara el archivo eduardo1.pdf, eduardo2.pdf, al correo [email protected] se le enviara el adjunto juan1.pdf, juan2.pdf, juan3.pdf y asi sucecivamente y ademas incluir cuerpo en el mensaje de correo.
Los datos de correo los pienso jalar desde otra hoja de Excel.
Espero su gran ayuda e estado buscando preguntas similares pero lamentablemente los archivos que adjuntan estan caidos en los servidores que los alojan.
6 Respuestas
Estoy desarrollando una macro para estados de cuentas, en una carpeta tengo más de 100 documentos PDF y en la primera columna tengo cada cliente pero son demasiados... cada PDF tiene el nombre correspondiente de cada cliente y lo que quiero es insertar los archivos que corresponden en cada celda sin la necesidad de seleccionar los archivos uno por uno...
Me sería de gran ayuda!
Te anexo mi aplicación para enviar varios correos, a diferentes destinatarios, con diferentes archivos, con diferentes asuntos, con diferentes cuerpos de mensaje.
'***Macro Para enviar correos
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
dam.send 'El correo se envía en automático
'dam.display 'El correo se muestra
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End SubEste es el enlace al archivo:
https://www.dropbox.com/s/ccu9fzc0s2c45cy/correo5b.xlsm?dl=0
Si no puedes descargar tu archivo, escríbeme a mi correo y te envío el archivo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Eduardo Cruz” y el título de esta pregunta.
Woooooow en verdad muchísimas gracias Dante por tomarte tu valioso tiempo y presicion en resolver mi duda acabo de hacer pruebas y justo es lo que necesitaba en verdad muchas gracias!
Adjunto un cambio para versiones 2010 y mayores
[code]'***Macro Para enviar correosSub 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).value 'Destinatarios
dam.CC = Range("C" & i).value 'Con copia
dam.Bcc = Range("D" & i).value 'Con copia oculta
dam.Subject = Range("E" & i).value '"Asunto"
dam.body = Range("F" & i).value '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j).value
If archivo <> "" Then dam.Attachments.Add archivo
Next
Next
MsgBox "Correos enviados", vbInformation, "
Macro para versiones excel 10 o superiores.
[code]Sub correo()'Por.Dante Amor
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = objOL.CreateItem(olMailItem)
'Set dam = CreateObject("outlook.application").CreateItem(0)
dam.To = Range("B" & i).Value 'Destinatarios
dam.CC = Range("C" & i).Value 'Con copia
dam.Bcc = Range("D" & i).Value 'Con copia oculta
dam.Subject = Range("E" & i).Value '"Asunto"
dam.Body = Range("F" & i).Value '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j).Value
If archivo <> "" Then dam.Attachments.Add archivo
Next
Set dam = Nothing
Next
MsgBox "Correos enviados", vbInformation, "
Archivo para la versión 2010 o superior
https://www.dropbox.com/s/gsqj0kf755ddyn3/correo5c%20muestra.xlsm?dl=0
Al parecer no pueden descargar la versión de Dropbox. Anexo nuevamente la liga:
https://www.dropbox.com/s/gsqj0kf755ddyn3/correo5c%20muestra.xlsm?dl=0
Ahora también lo pueden descargar de google drive:
https://drive.google.com/open?id=1xwqg9-Cq0HuPUlEoefO124CvwgII6I_s
Agradecería porfavor si me enviara el archivo para versión 10 o superior. Mil gracias! [email protected]
Tu aplicación es de valiosa ayuda, sin embargo tengo dos cuentas en la aplicación de outlook la personal y la corporativa para el caso en cuestión me es necesario enviar los adjuntos del correo corporativo, me podrías ayudar a modificar la macro.
Me ha sido muy útil el archivo pero no he podido enviarlos correctamente y a más de 5 correos, o me da error o los envía y notifica pero no llegan.
Ante todo expresarte mi más sincera admiración! Mil gracias por el tiempo que dedicas a aclarar dudas o ayudarnos y por el tiempo que nos has hecho ganar a todos, facilitando nuestro trabajo con Excel ! Admiración y gracias !
Al hilo de tu respuesta, necesitaría saber si me puedes ayudar en algo:
La solución que propones es fenomenal, pero implica seleccionar uno a uno los archivos que se quieren adjuntar. La duda es: ¿Se podría insertar el archivo de manera automática en función del valor de una celda? (Que corresponde con el nombre del archivo).
Si en la celda M" tengo escrito Antonio Pérez.pdf, que me vaya a la carpeta predeterminada, me busque el archivo Antonio Perez.pdf y me lo adjunte... (No se si me explico)
Por otro lado, la búsqueda que haces con la celda G2 de tu archivo, ¿Cómo lo has hecho?