10 Replies Latest reply: Dec 15, 2017 2:11 PM by Marcel Viegas RSS

    Macro e-mail

    Marcel Viegas

      Pessoal localizei uma macro aqui no forum adaptei ela, ela toda até o final sem apresentar erro só que o e-mail não chega.

      Segue abaixo:

       

      sub sendMail

      Dim objEmail

       

      Const cdoSendUsingPort = 2 ' Send the message using SMTP

       

       

      Const cdoAnonymous = 0 'Do not authenticate

      Const cdoBasic = 1 'basic (clear-text) authentication

      Const cdoNTLM = 2 'NTLM

       

       

       

      Const SMTPServer = "192.168.5.6"

      Const SMTPPort = 25          ' Port number for SMTP

      Const SMTPTimeout = 60      ' Timeout for SMTP in seconds

       

       

      'Sending mail

      Set objEmail = CreateObject("CDO.Message")

      Set objConf = objEmail.Configuration

      Set objFlds = objConf.Fields

      With objFlds

      '---------------------------------------------------------------------

          ' SMTP server details

          .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

          .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer

          .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous

      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort

      .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = false

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = SMTPTimeout

        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="xxxxxxxxxx"

          .Update

      '---------------------------------------------------------------------

      End With

       

      objEmail.To = "marcel.viegas@divinaprovidencia.org.br"

      objEmail.From = "marcel.viegas@divinaprovidencia.org.br"

      objEmail.Subject = "test"

      objEmail.TextBody = "message de test"

       

       

      objEmail.Send

       

      Set objFlds = Nothing

      Set objConf = Nothing

      Set objEmail = Nothing

       

       

      msgbox ("Test Mail Sent")

       

      end sub