Use CDO to send Email from Access

I asked a similar question not long ago and received what seemed to be an excellent. I was apparently overconfident in my abilities and don't know how to apply the code:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28635796.html#a40665760

Could someone take a peek and assist me through this?  I'm on a network that uses Gmail.
eossmaAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

gplanaCommented:
Here is the information about how to configure gmail smtp settings:
http://email.about.com/od/accessinggmail/f/Gmail_SMTP_Settings.htm

So try something like this:

strTo = "destination@email.here" ' You should put the email destination address here
strFrom = "your@email.here" ' You should put your own gmail email address here
strSubject = "My Subject" 'You should put the subject of email here
strBody = "The text of the e-mail" 'You should put the text of the email here
strServer = "smtp.gmail.com" ' The smtp gmail server here
intPort = 466 ' The SSL port (SSL is required for sending emails using gmail)
strUsername = strFrom 'The username should be the same as your gmail email address
strPassword = "Put the password of your gmail account here"
intSentUsing = 2 ' Use SMTP over network
intAuthenticate = 1 ' Basic Authentication
blnUseSSL = true

bOk = SendEmail(strTo, strFrom, strCC, strBCC, strSubject, strBody, strServer, intPort, strUsername, strPassword, intSentUsing, intAuthenticate, blnUseSSL)

if not bOk then
   MsgBox("Error","Error sending email")
end if

Open in new window


If something is wrong maybe you can debug inside the function and see what is happening.

Hope this helps. Regards.
0
MacroShadowCommented:
Here I removed the settings variables and changed them with the gmail settings.
The code should be copied to a regular module, then it can be called from anyplace in your application.
Option Explicit

Private Const URL_CDOCONFIG As String = "http://schemas.microsoft.com/cdo/configuration/"

Public Function SendEmail(ByVal strTo As String, _
                          ByVal strFrom As String, _
                          Optional ByVal strCC As String, _
                          Optional ByVal strBCC As String, _
                          Optional ByVal strSubject As String, _
                          Optional ByVal strBody As String, _
                          Optional ByVal strUsername As String, _
                          Optional ByVal strPassword As String, _
                          Optional ByVal strAttachment As String) _
                          As Boolean

    Dim strReport As String
    Dim cdoMsg As Object

    On Error Resume Next
    Err.Clear
    
    strSubject = "Write your subject here"
    strBody = "Write your message here"
    strUsername = "you@gmail.com" ' write your email address here
    strPassword = "yourpassword" ' write your email password here
    
    strFrom = strUsername

    Set cdoMsg = CreateObject("CDO.message")
    If Err Then
        Debug.Print Err.Description
        SendEmail = False
    Else
        With cdoMsg
            With .Configuration.Fields

                'Specifies the method used to send messages:
                '(1) Local SMTP Pickup Service (2) Use SMTP Over Network (3) Use Exchange Server
                .Item(URL_CDOCONFIG & "sendusing") = 2

                'The name (DNS) or IP address of the machine hosting the
                'SMTP service through which messages are to be sent.
                .Item(URL_CDOCONFIG & "smtpserver") = "smtp.gmail.com"

                'The SMTP Port which must be enabled in your network by ISP or local Firewall
                .Item(URL_CDOCONFIG & "smptserverport") = 465

                'Specifies the authentication mechanism to use
                'when authentication is required to send messages
                'to an SMTP service using a TCP/IP network socket:
                '(1) None (2) Basic (Base64 encoded) (3) NTLM
                .Item(URL_CDOCONFIG & "smtpauthenticate") = 1

                'Indicates whether Secure Sockets Layer (SSL) should be used when
                'sending messages using the SMTP protocol over the network or not.
                'SSL/STARTTLS: Boolean
                .Item(URL_CDOCONFIG & "smtpusessl") = True

                'Maximum Time in Seconds CDO will try to Establish Connection
                .Item(URL_CDOCONFIG & "smtpconnectiontimeout") = 10

                'Sender's Mail ID
                .Item(URL_CDOCONFIG & "sendusername") = strUsername

                'Sender's Password
                .Item(URL_CDOCONFIG & "sendpassword") = strPassword

                'Update Configuration Entries
                .Update

            End With
            .To = "Display Name <" & strTo & ">"
            .From = "Display Name <" & strUsername & ">"
            .CC = "Display Name <" & strCC & ">"
            .BCC = "Display Name <" & strBCC & ">"
            .ReplyTo = "Reply@something.com" 'change the reply address
'            .Sender = "" ' Must only be English characters
            .Subject = strSubject
            .TextBody = strBody
            If Len(strAttachment) > 0 Then
                .AddAttachment strAttachment
            End If
            If Err Then
                Debug.Print Err.Description
                SendEmail = False
            Else
                DoCmd.Hourglass True
                .send
                DoCmd.Hourglass False
                If Err Then
                    Debug.Print Err.Description
                    SendEmail = False
                Else
                    SendEmail = True
                End If
            End If
        End With
    End If

End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.