Envio de e-mail direto sem outlook...

Prezados bom dia!

Estava procurando uma rotina desse tipo a muito tempo e não a encontrava para uso no access, após muita procura ela veio cair em minhas mãos e achei interessante o compartilhamento da mesma. Eu a utilizo e é 100% funcional... A mesma foi encontrada em um BD do nosso site www.svcsoftwarehouse.com

Deverá ser referenciada no access o seguinte objeto: MICROSOFT CDO FOR WINDOWS 2000 LIBRARY

Function EnviarEmail()
On Error GoTo erromail
Dim Mens As CDO.Message
Dim Config As CDO.Configuration

Set Config = New CDO.Configuration

With Config

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.suaconta.com.br" 'seu servidor de e-mail
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 ' porta usada pelo seu servidor de e-mail
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "o nome do usuario para logon no servidor" 'user do servidor
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "senha do servidor" 'coloque a senha do seu email
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update

End With

Set Mens = New CDO.Message

With Mens

Set .Configuration = Config
.From = "Nome de quem envia" 'quem envia

If Not IsNull(Me.txtDeMail) Then
.Sender = Me.txtDeMail 'email de quem envia.
End If

If Not IsNull(Me.txtCOculta) Then
.BCC = Me.txtCOculta
End If

.Subject = Me.txtAssunto 'caixa texto assunto
.TextBody = Me.txtMensagem 'Caixa texto com o texto"

If Not IsNull(Me.txtPara) Then
.To = Me.txtPara 'caixa texto para quem vai o email"
End If

If Not IsNull(Me.txtAnexo) Then
.AddAttachment (Me.txtAnexo)
End If

.Send ' envia

End With

MsgBox "Menssagem enviada com sucesso"

Set Mens = Nothing
Set Config = Nothing
Exit Function

erromail:
MsgBox Err.Number & " " & Err.Description
Set Mens = Nothing
Set Config = Nothing
Exit Function

End Function

Abraços...