Adjuntar un archivo individual y diferente con Macro en correo Gmail para multiples destinatarios
publicado
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
'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
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
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 = "[email protected]"
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