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

Respuesta
26

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 Sub

Este 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 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).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, "

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 

Respuesta
1

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!

Respuesta

Agradecería porfavor si me enviara el archivo para versión 10 o superior. Mil gracias! [email protected]

Respuesta

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.

Respuesta

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.

Respuesta

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?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas