Logo Hardware.com.br
Diego100ges
Diego100ges Novo Membro Registrado
1 Mensagem 0 Curtidas

VBA enviar emails pelo gmail

#1 Por Diego100ges 23/10/2019 - 10:37
Prezados, bom dia.
Estou com uma dificuldade em uma macro, e vi em outro tópico parecido uma solução porém não estou conseguindo aplicar para meu uso, o tópico foi esse https://www.hardware.com.br/comunidade/vba-erro/1422576/ resolvido pelo usuário Basole.
Gostaria de uma força para resolver o código, acredito que o ERRO seja o mesmo do tópico mencionado, quando eu tento disparar um único e-mail OK a macro funciona! porém ao adicionar mais emails ela apresenta erro.
segue código:
[code=vb]
Sub email_gmail()
Dim iMsg, Cdo_Conf, Flds
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set Cdo_Conf = CreateObject("CDO.Configuration")

Dim servidor_smtp As String
Dim conta_autenticada As String
Dim senha_para_envio As String
Dim email_origem As String
Dim email_destino As String
Dim email_porta As Integer
Dim i As Integer
Dim Row As Integer

Row = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Row
If Range("A" & i).Value = "ok" Then
servidor_smtp = "smtp.gmail.com" ' Informacoes so seu servidor SMTP
senha_para_envio = "SUA SENHA AQUI" ' senha da conta de e-mail
email_origem = "SEU EMAIL AQUI" ' e-mail que indica de onde partiu a mensagem
email_destino = Range("d" & i) ' e-mail que vai receber as mensagens do formulario
email_assunto = Range("g" & i) ' Assunto do email
email_corpo = Range("h" & i) ' Corpo do Email
email_porta = 465 ' porta smtp
End If
Next
Cdo_Conf.Fields.Item(sch & "sendusing") = 2
Cdo_Conf.Fields.Item(sch & "smtpauthenticate") = 1
Cdo_Conf.Fields.Item(sch & "smtpserver") = servidor_smtp
Cdo_Conf.Fields.Item(sch & "smtpserverport") = email_porta
Cdo_Conf.Fields.Item(sch & "smtpconnectiontimeout") = 60
Cdo_Conf.Fields.Item(sch & "sendusername") = email_origem
Cdo_Conf.Fields.Item(sch & "sendpassword") = senha_para_envio
Cdo_Conf.Fields.Item(sch & "smtpusessl") = True
Cdo_Conf.Fields.Update

Set Cdo_Mensagem = CreateObject("CDO.Message")
Set Cdo_Mensagem.Configuration = Cdo_Conf

Cdo_Mensagem.BodyPart.Charset = "iso-8859-1"
Cdo_Mensagem.From = email_origem
Cdo_Mensagem.to = email_destino
Cdo_Mensagem.Subject = email_assunto

'Cdo_Mensagem.AddAttachment ("") ' Insere o Anexo

strBody = email_corpo
Cdo_Mensagem.HTMLBody = strBody
Cdo_Mensagem.Send
Set Cdo_Mensagem = Nothing
Set Cdo_Conf = Nothing


MsgBox "E-mail enviado com sucesso"

End Sub
[/code]
© 1999-2024 Hardware.com.br. Todos os direitos reservados.
Imagem do Modal