✔ VBA Dashboards Specialist®: VBA Tips - Enviando e-mail com código VBA

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba 3 Calendários Customizáveis de 2013 em Excel

Usando Gauges em Dashboards no MS Access

O endereço do servidor de SMTP do GMail é "smtp.gmail.com". Este servidor requer conexões SSL ou TLS, e através destes poderemos enviar emails através da autenticação ESMTP. Por exemplo, digamos que o seu email seja "bernardess@gmail.com", e o seu nome de usuário seja "bernardess@gmail.com".

Note que:

- O exemplo a seguir demonstra um código através do qual poderá enviar mensagens de email através do servidor de SMTP do GMail.

- Para implementar completamente este projeto, certifique-se de baixar e instalar o programa EASendMail na sua máquina.

- Para rodar o projeto corretamente, lembre-se de configurá-lo corretamente, mude o Servidor SMTP, o usuário, a senha, o destino, etc...

Divirta-se:

Private Sub btnSendMail_Click()

Dim oSmtp As New EASendMailObjLib.Mail

Let oSmtp.LicenseCode = "TryIt"

' Set your Gmail email address

Let oSmtp.FromAddr = "bernardess@gmail.com"

' Add recipient email address

oSmtp.AddRecipientEx "bernardess@gmail.com", 0

' Set email subject

Let oSmtp.Subject = "test email from gmail account"

' Set email body

Let oSmtp.BodyText = "this is a test email sent from VB 6.0 project with gmail"

' Gmail SMTP server address

Let oSmtp.ServerAddr = "smtp.gmail.com"

' If you want to use direct SSL 465 port,

' Please add this line, otherwise TLS will be used.

' oSmtp.ServerPort = 465

' detect SSL/TLS automatically

oSmtp.SSL_init

' Gmail user authentication should use your

' Gmail email address as the user name.

' For example: your email is "bernardess@gmail.com", then the user should be "bernardess@gmail.com"

Let oSmtp.UserName = "bernardess@gmail.com"

Let oSmtp.Password = "SUA SENHA"

MsgBox "start to send email ..."

If oSmtp.SendMail() = 0 Then

MsgBox "email was sent successfully!"

Else

MsgBox "failed to send email with the following error:" & oSmtp.GetLastErrDescription()

End If

End Sub

E sim, temos uma outra versão para você explorar:

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'>>> Database by Tony Hine, alias Uncle Gizmo <<<
'>>> Created Mar, 2011 <<<

'>>> Last up-dated Mar, 2011 <<<
'>>> Telephone International: +44 1635 522233 <<<

'>>> Telephone UK: 01635 533322 <<<
'>>> e-mail: email@tonyhine.co.uk <<<

'>>> Skype: unclegizmo <<<
'>>> I post at the following forum (mostly) : <<<

'>>> http://www.access-programmers.co.uk/forums/ (alias Uncle Gizmo) <<<
'>>> You can also find me on the Ecademy: http://www.ecademy.com/user/tonyhine<<<
'>>> try this website: http://www.tonyhine.co.uk/example_help.htm <<<

'>>> I have now started a forum which contains video instructions here: <<<
'>>> http://msAccessHintsAndTips.Ning.Com/ <<<

'>>> CODE SUPPLIED NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Public Function fSendGmail (ByVal sTo As String, ByVal sEmail As String, ByVal sPass As String, _

ByVal strMsg As String, ByVal strSubject As String) As Boolean 'Returns True if No Errors

On Error GoTo Err_ErrorHandler

fSendGmail = True

'Extract
'This basic example sends a simple, no-frills text message every time the script is run: '

'Example File script0603.vbs '

'Extract
'The SendMail() Function
'While longer, SendMail( ) is itself a simpler function than GetData( ) . It simply creates three '

'objects: CDO. Message, CDO. Configuration, and a subobject of CDO. Configuration called '
'Fields . The Scripting library used in GetData() is a default part of the ASP namespace, and '

'therefore any new object created in the Scripting library is known. To use objects in the CDO '
'library, the METADATA statements at the top of the ASP page are necessary. '

'Standard CDO Constants
'NOTE --- If you set conCdoSmtpUseSSL to True, you may need to set conCdoSendUsingPort to 465 or port number specified by your ISP.

Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
Const conCdoSendUsingPort As Integer = 2 'If incorrect raises this Error: -2147220960
'Const conSendPassword As String = "YourGmailPasswordHere"
Const conCdoBasic As Integer = 1
'Const conSendUserName As String = "YourGmailAddrHere@gmail.com"
Const conStrSmtpServer As String = "smtp.gmail.com" 'If incorrect raises this Error: -2147220973
Const conCdoSmtpUseSSL As Boolean = True 'Use Secure Sockets Layer (SSL) when posting via SMTP.

Const conCdoSmtpServerPort As Integer = 465 'Can be 465 or 587 'If incorrect raises this Error: -2147220973

Dim oMsg As Object
Dim oConf As Object

Dim strEmailAddr As String
'CHANGE THIS!!

'strEmailAddr = sTo & ""

'Create Objects
Set oMsg = CreateObject("CDO.Message")

Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf

'Build the Message
With oMsg
.To = "" & sTo 'If incorrect you will get an email From: Delivery Status Notification (Failure) Delivery to the following recipient failed permanently:

.From = "Grievance Tracker <" & sEmail & ">" 'If incorrect raises this Error: -2147220973
.Subject = strSubject

.textBody = strMsg
'.AddAttachment "H:\ATHDrive\ATH_Programming\ATH_Office\Access2007\My_MS_Access_Tools\GoogleEmail\TransscriptGmailFromVBA.txt"

End With

''Set Delivery Options
With oConf.Fields

.Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
.Item(conStrPrefix & "smtpserver") = conStrSmtpServer

.Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
.Item(conStrPrefix & "sendusername") = sEmail

.Item(conStrPrefix & "sendpassword") = sPass
'.Item(conStrPrefix & "sendusername") = conSendUserName 'IF you want to hard code the username you can reactivate this line.

'.Item(conStrPrefix & "sendpassword") = conSendPassword 'IF you want to hard code the password you can reactivate this line.
.Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
.Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
.Update 'Commit Changes
End With

'Deliver the Message
oMsg.Send

Exit_ErrorHandler:
'Access 2007 Developer Reference > Microsoft Data Access Objects (DAO) Reference > DAO Reference > Recordset Object > Methods

'An alternative to the Close method is to set the value of an object variable to Nothing (Set dbsTemp = Nothing).
Set oMsg.Configuration = Nothing

Set oConf = Nothing
Set oMsg = Nothing
Exit Function

Err_ErrorHandler:
If Err.Number <> 0 Then fSendGmail = False
Select Case Err.Number

Case -2147220977 'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
MsgBox "Error From --- fSendGmail --- Incorrectly Formatted Email --- Error Number >>> " _

& Err.Number & " Error Desc >> " & Err.Description, , "Format the Email Address Correctly"

Case -2147220980 'Likely cause, No Recipient Provided (No Email Address)
MsgBox "Error From --- fSendGmail --- No Email Address --- Error Number >>> " _

& Err.Number & " Error Desc >> " & Err.Description, , "You Need to Provide an Email Address"

Case -2147220960 'Likely cause, SendUsing Configuration Error
MsgBox "Error From --- fSendGmail --- The SendUsing configuration value is invalid --- LOOK HERE >>> sendusing) = conCdoSendUsingPort --- Error Number >>> " _

& Err.Number & " Error Desc >> " & Err.Description, , "SendUsing Configuration Error"


Case -2147220973 'Likely cause, No Internet Connection
MsgBox "Error From --- fSendGmail --- No Internet Connection --- Error Number >>> " _

& Err.Number & " Error Desc >> " & Err.Description, , "No Internet Connection"


Case -2147220975 'Likely cause, Incorrect Password
MsgBox "Error From --- fSendGmail --- Incorrect Password --- Error Number >>> " _

& Err.Number & " Error Desc >> " & Err.Description, , "Incorrect Password"

Case Else 'Report Other Errors
MsgBox "Error From --- fSendGmail --- Error Number >>> " & Err.Number _
& " <<< Error Description >> " & Err.Description
End Select

Resume Exit_ErrorHandler
End Function 'fSendGmail