[Resolvido]Enviar e-mail por CDO

Boas,

Estou recorrendo aos mestres do Access, porque já tentei de tudo e não consigo enviar e-mail pelo CDO. Preciso essa função porque ao gerar um novo documento ou quando o trabalho estiver concluído o sistema envia um e-mail informativo.

Já tentei todas as opções do forum e da internet em geral.

Utilizo o Access 2016 32bits e em rede corporativa.

Posto o bd com todos os códigos tentado.

Cumprimentos,

Bruno Nunes

Bom dia amigo de uma olhada neste artigo

usandoaccess.com.br/tutoriais/enviar-email-usando-o-cdosys.asp?id=1

atraves dele eu consegui enviar da ate pra usar um dlookup numa tabela para buscar as configurações e o servidor mais fácil para usar e configurar e o gmail.

Marcelo, bom dia!

Obrigado pela ajuda, mas já havia testado e estudado sobre este artigo.

Conseguir resolver este problema com o T.I aqui da empresa, não conseguia enviar e-mail devido bloqueio de proxy.

Abaixo coloco a rotina que estou utilizando e funcionou.

Código:


Function EnviarEmailCDO(Para As String, Assunto As String, Texto As String) As Boolean


Dim iMsg, Cdo_Conf, Flds

 

sch = "http://schemas.microsoft.com/cdo/configuration/"
Set Cdo_Conf = CreateObject("CDO.Configuration")


'Variaveis

Dim servidor_smtp As String
Dim conta_autenticada As String
Dim senha_para_envio As String
Dim email_origem As String
Dim email_porta As Integer

 

'Abaixo seguem algumas definicoes de variaveis para o envio de seu formulario. Por favor preencha os campos abaixo.

servidor_smtp = "smtp.gmail.com" ' Informacoes so seu servidor SMTP
senha_para_envio = "Txxxx" ' senha da conta de e-mail
email_origem = "xxxx@gmail.com" ' e-mail que indica de onde partiu a mensagem
'email_destino = "xxxx@gmail.com" ' e-mail que vai receber as mensagens do formulario
'email_assunto = "Teste" ' Assunto do email
'email_corpo = "Teste corpo do Email..." ' Corpo do Email
email_porta = 25 ' porta smtp


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(sch & "urlproxyserver") = "xxx.xxx.xxx.xxx"
'Cdo_Conf.Fields(sch & "proxyserverport") = "8080"
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 = Para
Cdo_Mensagem.Subject = Assunto


'------Para anexar arquivo use uma das linguagens abaixo
'Cdo_Mensagem.AddAttachment (ThisWorkbook.Path & "\Envio\Arquivo das Lojas Envio.xlsm")
  'ou
'Cdo_Mensagem.AddAttachment ("C:\Envio\Arquivo das Lojas Envio.xlsm")


strBody = Texto

 

Cdo_Mensagem.HTMLBody = strBody

Cdo_Mensagem.Send

 

Set Cdo_Mensagem = Nothing
Set Cdo_Conf = Nothing

 

'MsgBox "E-mail enviado com sucesso"
SysCmd acSysCmdSetStatus, "Sucessfully send to e-mail..."

SysCmd acSysCmdClearStatus

End Function