• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 325
  • Last Modified:

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:


Could someone take a peek and assist me through this?  I'm on a network that uses Gmail.
1 Solution
Here is the information about how to configure gmail smtp settings:

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.
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
    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
        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

            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
                DoCmd.Hourglass True
                DoCmd.Hourglass False
                If Err Then
                    Debug.Print Err.Description
                    SendEmail = False
                    SendEmail = True
                End If
            End If
        End With
    End If

End Function

Open in new window

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now