Macro de Excel para enviar correos de Gmail
Ya tengo armada la macro para envíar correos desde el excel por un gmail, con UN solo correo me funciona bien, pero quisiera que me tome diferentes celdas donde se vayan cargando los e-mails y los envie a todos a la vez.
Para que se entienda el contexto, es una lista de presentismo que una vez que termina el evento, le manda a cada uno de los que fue a trabajar un comprobante de que estuvo presente. El código es este:
Sub enviar_correo()
Dim Email As CDO.Message
Set Email = New CDO.Message
Correo = "[email protected]"
passwd = "XXXX"
Destino = "RANGE("SERVICIO M3! J12:j900").value (acá es donde quiero que me tome varios mails que se vayan cargando en esas celdas de la hoja llamada "servicio m3", las cuales se completarán una vez que se hagan presentes en el trabajo)
Asunto = "Comprobante de asistencia a Evento Futbolistico"
Cuerpo = Range("DATOS!A29").Value
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
.BCC = Destino
.From = Correo
.Subject = Asunto
.TextBody = Cuerpo
.Configuration.Fields.Update
.Send
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
2 Respuestas
Por lo que veo tu código está bien, puedes tener los correos en una celda y con eso los haces llamar, yo lo que tengo son todos en la línea y me funciona bien.
With OLMail .To = "'" .CC ="" .Subject = .Display '.send End With
O bien, mandando llamar rangos específicos en donde tengo la información:
'Crear el correo y mostrarlo
With Correo
.To = pagina1.Range("Q2").Value
.CC = pagina1.Range("Q3").Value
.Subject = pagina1.Range("Q4").Value
.Display
End WithOjalá te sirve y no olvides votar.
No sé si te permita 1000 nombres de correo al mismo tiempo, pero prueba lo siguiente para poner 20 nombres correos y revisa si te funciona. Aumenta el número de nombres de correos y realiza pruebas.
Sub enviar_correo()
Dim Email As CDO.Message
Dim Correo As String, passwd As String, Destino As String, Asunto As String
Dim i As Long
Dim sh As Worksheet
'
Set Email = New CDO.Message
Set sh = Sheets("SERVICIO M3")
Correo = "[email protected]"
passwd = "XXXX"
'
For i = 12 To 31
Destino = Destino & sh.Range("J" & i).Value & "; "
Next
Asunto = "Comprobante de asistencia a Evento Futbolistico"
End Sub