Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

martin216

Adjuntar un archivo individual y diferente con Macro en correo Gmail para multiples destinatarios

Recommended Posts

Hola favor necesito de vuestra ayuda!!! mi problema es que quiero adjuntar un solo archivo (ya creados en pdf) a cada dirección de correo que esta en la columna 14 y filas 1 en adelante; y desde el segundo correo me va adjunto el archivo anterior más el correspondiente de fila 2; en el tercero, los dos anteriores, más el de la tercera fila y así sucesivamente. Favor vuestra ayuda en .AddAttachment

Les dejo todo el código: 

Sub SendMail_Gmail()
Dim Email As CDO.Message
Set Email = New CDO.Message

correo = "xxxxxxxxxxx@gmail.com"
passwd = "123456789"
mensaje = Range("A1")
cuerpo = Range("B1")
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
    .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With

With Email
For i = 1 To 10

    'El valor de i se pone en la celda F4 para que con BUSCARV se devuelvan
    'los datos correspondientes al ID para encontrar la dirección de correo del destinatario
    'al ir cambiando F4 se cambia la dirección en B5
    ThisWorkbook.Sheets("Resumen").Range("F4").Value = i
    
    .To = ThisWorkbook.Sheets("Resumen").Range("B5").Value
    .From = correo
    .Subject = mensaje
    .TextBody = cuerpo
    .AddAttachment Sheets("resumen").Cells(i, 14).Value 'celdas de rutas de archivo a adjuntar en cada correo, un archivo por correo
      
    .Configuration.Fields.Update
    On Error Resume Next
    .Send
    
Next i

End With

    If Err.Number = 0 Then
        MsgBox "El mail se envió con éxito", vbInformation, "Informe"
    Else
        MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
    End If

End Sub

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png