Enviar correos automaticamente Gmail
Publicado por art (1 intervención) el 16/04/2024 12:49:54
Hola amigos! que tal?
Vereis estoy intentando crear un macro que envie correos automaticamente en excel, mediante CDO, pero me da error en el servidor smtp, este es el código que estoy utilizando.
A ver si podeis ayudarme! Gracias! Estoy utilizando un ejemplo que encontre para ver si era posible y simplemente luego ajustarlo a mis necesidades. He habilitado la contraseña de aplicaciones de google, pero aún así no lo consigo.
Vereis estoy intentando crear un macro que envie correos automaticamente en excel, mediante CDO, pero me da error en el servidor smtp, este es el código que estoy utilizando.
A ver si podeis ayudarme! Gracias! Estoy utilizando un ejemplo que encontre para ver si era posible y simplemente luego ajustarlo a mis necesidades. He habilitado la contraseña de aplicaciones de google, pero aún así no lo consigo.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub EnviarCorreo()
Debug.Print "Iniciando el envío de correos..."
Dim Email As CDO.MessageDim CorreoOrigen As String
Dim ClaveCorreo As String
CorreoOrigen = Range("i3").Value
ClaveCorreo = Range("i4").Value
Sheets("Mails").Select
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Debug.Print "Enviando correo en la fila " & i
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/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 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") = CorreoOrigen
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = ClaveCorreo
End With
With Email
.From = CorreoOrigen
.To = Range("A" & i).Value
.CC = Range("B" & i).Value
.BCC = Range("C" & i).Value
.Subject = Range("D" & i).Value
.TextBody = Range("E" & i).Value
.Attachments.DeleteAll
.AddAttachment (Range("F" & i).Value)
.Configuration.Fields.Update
Debug.Print "Cuerpo del mensaje: " & .TextBody
End With
On Error Resume Next
Email.SendIf Err.Number <> 0 Then
Debug.Print "Error al enviar el correo en la fila " & i & ": " & Err.Description
Err.Clear ' Limpia el error para continuar con la ejecución del bucle
End If
Set Email = NothingNext
Debug.Print "Envío de correos completado."
End Sub
Valora esta pregunta
0