Option Compare Database
Option Explicit
'// module with function for sending email thru Gmail server
Dim EmailAccount As String
Dim EmailErrorsTo As String
Dim EmailPassword As String
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)
'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
10 On Error GoTo ErrorHandler
20 Set objMessage = CreateObject("CDO.Message")
30 objMessage.Subject = strSubject
40 objMessage.FROM = EmailAccount
50 If IsMissing(strTo) Or strTo = "" Then
60 objMessage.To = EmailErrorsTo
70 Else
80 objMessage.To = strTo
90 End If
100 If blnHTMLFormat Then
110 objMessage.HTMLBody = strMessage
120 Else
130 objMessage.TextBody = strMessage
140 End If
150 If strCC <> "" Then
160 objMessage.cc = strCC
170 End If
180 If strBCC <> "" Then
190 objMessage.BCC = strBCC
200 End If
'==This section provides the configuration information for the remote SMTP server.
210 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
220 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
230 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Your UserID on the SMTP server
240 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailAccount
'Your password on the SMTP server
250 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPassword
'Server port (typically 25)
260 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
'Use SSL for the connection (False or True)
270 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)
280 objMessage.Configuration.Fields.Item _
("
http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
290 objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
300 DoCmd.Hourglass True
310 objMessage.send
320 DoCmd.Hourglass False
ExitHere:
330 On Error Resume Next
340 Set objMessage = Nothing
350 DoCmd.Hourglass False
360 Exit Sub
ErrorHandler:
370 Select Case Err
Case 0
380 Resume Next
390 Case Else
400 LogError Err.Number, Err.Description, Erl, "Gmail", "mdlGmail"
410 Resume ExitHere
420 End Select
End Sub
