Modificar macro envío correo gmail
Ingeniero Dante Amor
Sub EnviarPorGmail()
'Por.Dante Amor
Dim Email As CDO.Message
correo = Range ("B1")'[email protected]"
passwd = Range ("B2") 'xxxx"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set Email = New CDO.Message
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
.To = Cells(i, "A")
.From = correo
.Subject = Cells(i, "B")
.TextBody = Cells(i, "C")
.AddAttachment Cells(i, "E") & Cells(i, "D")
.Configuration.Fields.Update
On Error Resume Next
.Send
End With
If Err.Number = 0 Then
Cells(i, "F") = "El mail se envió con éxito"
Else
Cells(i, "F") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
End If
Set Email = Nothing
Next
End SubSu macro funciona perfecto, pero deseo que la lista de destinatarios comience en la Fila "A10" , Correo "B10" y Ruta "C10" y estatus en "D10"
He intentado cambiar el bucle pero nada que me funciona. Así sería la posición deseada.
1 Respuesta
Respuesta de Dante Amor
1
Le hice unos cambios según la imagen
Sub EnviarPorGmail()
'Por.Dante Amor
Dim Email As CDO.Message
correo = Range("B1").Value '[email protected]"
passwd = Range("B2").Value 'xxxx"
For i = 10 To Range("A" & Rows.Count).End(xlUp).Row
Set Email = New CDO.Message
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
.To = Cells(i, "A").Value
.From = correo
.Subject = Range("B1").Value
.TextBody = Range("B3").Value & " " & Range("B4").Value & " " & Range("B5").Value & _
Range("B6").Value & " " & Range("B7").Value
archivo = Cells(i, "C").Value & Cells(i, "B").Value
If Dir(archivo) <> "" Then
.AddAttachment archivo
End If
.Configuration.Fields.Update
On Error Resume Next
.Send
End With
If Err.Number = 0 Then
Cells(i, "D") = "El mail se envió con éxito"
Else
Cells(i, "D") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
End If
Set Email = Nothing
Next
End SubPrueba y me comentas.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Hola Ingeniero Dante bota el siguiente error
Cambia esta
.To = Cells(i, "A").Value
Por esta
. To = Cells(i, "¿A")
En qué fila va la variable i?
Puedes ver qué número tiene la variable i solamente acerca el puntero del mouse a la letra i y te va a mostrar un número.
¿Desde la fila 10 en adelante tienes datos o tienes algunas celdas vacías?
