Skip to main content
cancel
Showing results for 
Search instead for 
Did you mean: 
marcelviegas
Creator II
Creator II

Macro e-mail

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

10 Replies
marcelviegas
Creator II
Creator II
Author

Obrigado yuri o ip que me passaram foi "192.168.5.6".