Option Compare Database
Option Explicit

Public Const EmailAccount = "myGmailEmail@gmail.com"
Public Const EmailPassword = "myGmailPassword"
Public Const EmailErrorsTo = "DefaultToAddress@gmail.com"

Public Sub Gmail(strSubject As String, strMessage As String, Optional strTo As String, Optional strCC As String = "", Optional strBCC As String = "", Optional blnHTMLFormat As Boolean = False, Optional strAttachmentURL As String = "")
    'this code derived from:
    'http://www.paulsadowski.com/wsh/cdo.htm




    Const cdoSendUsingPickup = 1                      'Send message using the local SMTP service pickup directory.
    Const cdoSendUsingPort = 2                        'Send the message using the network (SMTP over the network).

    Const cdoAnonymous = 0                            'Do not authenticate
    Const cdoBasic = 1                                'basic (clear-text) authentication
    Const cdoNTLM = 2                                 'NTLM


    Dim objMessage As Object 'Message
   On Error GoTo ErrorHandler
    Set objMessage = CreateObject("CDO.Message") ' New Message
    objMessage.Subject = strSubject
    objMessage.FROM = EmailAccount
    If IsMissing(strTo) Or strTo = "" Then
        objMessage.To = EmailErrorsTo
    Else
        objMessage.To = strTo
    End If
    If blnHTMLFormat Then
        objMessage.HTMLBody = strMessage
    Else
        objMessage.TextBody = strMessage
    End If
    If strCC <> "" Then
        objMessage.cc = strCC
    End If
    If strBCC <> "" Then
        objMessage.BCC = strBCC
    End If
    If strAttachmentURL <> "" Then
        objMessage.AddAttachment strAttachmentURL
    End If
    
    '==This section provides the configuration information for the remote SMTP server.

    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    'Name or IP of Remote SMTP Server
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

    'Type of authentication, NONE, Basic (Base64 encoded), NTLM
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

    'Your UserID on the SMTP server
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailAccount

    'Your password on the SMTP server
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPassword

    'Server port (typically 25)
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

    'Use SSL for the connection (False or True)
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

    'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
    objMessage.Configuration.Fields.Item _
            ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

    objMessage.Configuration.Fields.Update

    '==End remote SMTP server configuration section==

    DoCmd.Hourglass True
    objMessage.send
    DoCmd.Hourglass False

ExitHere:
   On Error Resume Next
   Set objMessage = Nothing
   DoCmd.Hourglass False
   Exit Sub

ErrorHandler:
Select Case Err
Case 0
   Resume Next
Case Else
   Msgbox "Error " & Err.Number & " - " & Err.Description
   Resume ExitHere
End Select

End Sub