Referencia de envío de correo por gmail desde excel
Para Dante Amor: ¿Cómo puedo una vez enviado el correo desde excel que me escriba en la columna "M" "enviado" para así no enviar otra vez el correo si cumple esa función?
Private Sub Workbook_Open()
Dim Email As CDO.Message
correo = "[email protected]"
passwd = "+pescado123"
For i = 2 To Range("L" & 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, "L")
.From = correo
.Subject = Cells(i, "B")
.TextBody = Cells(i, "C")
.Configuration.Fields.Update
On Error Resume Next
.Send
End With
Set Email = Nothing
Next
End Sub
1 respuesta
Te anexo la macro con la actualización
Private Sub Workbook_Open() Dim Email As CDO.Message correo = "[email protected]" passwd = "+pescado123" For i = 2 To Range("L" & Rows.Count).End(xlUp).Row If Cells(i, "M") <> "enviado" Then 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, "L") .From = correo .Subject = Cells(i, "B") .TextBody = Cells(i, "C") .Configuration.Fields.Update On Error Resume Next .Send If Err.Number = 0 Then Cells(i, "M") = "enviado" Else Cells(i, "M") = "error : " & Err.Description End If End With Set Email = Nothing End If Next End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
