Envío mails a varios destinatarios con 2 archivos adjuntos.

Alguien me podría ayudar y decirme ¿cómo seria el código para el envío por mail de 2 archivos adjuntos a varios destinatarios de un listado de Excel en el que constarían sus nombres y dirección de correo?

1 respuesta

Respuesta
1

H o l a:

Para eso tengo desarrollada una aplicación.

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 el 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 “Luis Fernandez Miguelañez” y el título de esta pregunta.

Avísame en esta pregunta cuando me lo hayas enviado.


':)
':)


Hola Dante, muchas gracias por tu amable respuesta, lo único que tengo un problema que al presionar el botón de enviar correo se me abre una ventana de error de Visual Basic que dice:

Error en el método To de objeto _MailItem

Me podrías indicar a que es debido y como solucionarlo

Muchas gracias

Revisa mi respuesta en este enlace, ahí hay una macro alternativa que quizás resuelva tu problema.

Macro para enviar correos masivos con adjuntos diferentes pdf

Muchas gracias Dante,

He hecho los cambios que vienen en esta macro y me sigue dando el mismo error.

¿Qué versión de excel tienes?

¿Es de office o de mac?

¿Puedes poner la última macro que estás utilizando?

Hola Dante,

La version que utilizo es 2013.

He encontrado una macro que me funciona muy bien y se adapta perfectamente a lo que necesito, solo tiene un pero que según esta diseñado el código solo puedo enviar un archivo adjunto.

Abusando de tu amabilidad te voy a adjuntar el código y la página de Excel para ver si tu puedes hacer algún pequeño cambio y se puedan enviar al menos dos archivos adjuntos a cada destinatario.

Muchas gracias por todo

H o l a:

En la macro que pusiste tienes esta línea:

ruta_archivo = Cells(13, 5).Value

Significa que el nombre del archivo está en la fila 13 columna 5

Entonces, agrega esta línea para indicar que el segundo archivo estará en la fila 13 columna 6:

ruta_archivo2 = Cells(13, 6).Value

Cambia el 13 y el 6 por la fila y columna donde tienes el segundo archivo.


Ahora después de estas líneas:

If ruta_archivo <> "" Then
    With mItem
        .attachments.Add (ruta_archivo)
    End With
End If

Pon estas líneas:

If ruta_archivo2 <> "" Then
    With mItem
        .attachments.Add (ruta_archivo2)
    End With
End If

':)
':)

Hola Dante buenas noches, ante todo muchas gracias por tu interés y rapidez en las respuestas.

He hecho los cambios que me has indicado como ves en los archivos que te adjunto y cuando quiero adjuntar el segundo archivo me lo pone en la misma celda donde ha puesto el primero.

No se si tendrá algo que ver que en la segunda macro Sub selec_archivo (), que esta a la parte de abajo no he hecho ningún cambio.

Saludos

Cambia la segunda macro por esta:

Sub selec_archivo()
    On Error GoTo a2
    ruta_archivo = Application.GetOpenFilename(Title:="selcciona el archivo para mail")
    If ruta_archivo = False Then
        Exit Sub
    Else
        Cells(13, 5).Value = ruta_archivo
        ruta_archivo2 = Application.GetOpenFilename(Title:="selcciona el archivo para mail")
        If ruta_archivo2 = False Then
            Exit Sub
        Else
            Cells(13, 6).Value = ruta_archivo
        End If
    End If
a2:
End Sub

':)
':)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas