Views

VBA Tips - Enviando e-mail com código VBA - Send From GMail





Baixe o Calendário Compacto para 2014 em Excel



O que é o fenômeno chamado BIG DATA?




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


Tags: VBA. GMail, e-mail, mail, send, SMTP, SSL, TLS, ESMTP, CDO, 






Tags: , , , , , , , ,

Nenhum comentário:

Postar um comentário

Assinar: Postar comentários (Atom)
diHITT - Notícias