[AccessD] SMTP or Outlook?

Hi Rocky,

I use CDO which does not need any client system.  Code below, as you can see
I hold the parameters in a table, but have put the defaults as comments on
the lines.  Got bits from the web some time ago and heavily modified it.  I
have been using it now for some time and it works perfectly everytime.  No
Outlook, etc, just an account that you can send mail through.
Watch for word wraps.

Max Sherman

Option Compare Database
Option Explicit

Public Function pfEmailByCDO(strSubject As String, strBody As String, _
      strTo As String, strCC As String, strBCC As String, bDisplay As
Boolean, Optional strAttachment As String)
  On Error GoTo errhandler
  Dim gdatStarted As Date, gdatFinished As Date
  gdatStarted = Now
  Dim strFrom As String ', strAttachment As String
  Dim varPort As Variant, varSendVia As Variant, varAuthenticate As Variant
  Dim varServerPort As Variant, varSecs2Wait As Variant, sql2 As String
  Dim strUserName As String, strPwd As String, strUseSSL As String
  Dim sql As String
  Const conErr1 As String = "The server rejected one or more recipient
addresses. The server response was: 550 "
  Const conErr2 As String = "The server rejected one or more recipient
addresses. The server response was: 501 bad address syntax: <"
  Const ConErrX As String = "The transport failed to connect to the server"
  Dim strErr As String, strDomain As String, strEmailMaxail As String,
strFind As String
  Call pfLogEvent("Function: 'pfEmailByCDO' - Started")
  ' for testing, ignore rst2 and just the test table
  Dim objMessage, SendTo
  Dim dbs As DAO.Database, rstParams As DAO.Recordset
  Dim rstErr As DAO.Recordset
  Set dbs = CurrentDb
  '  Set rstErr = Me.RecordsetClone
  gbSendEmails = True
  If gbSendEmails = False Then
    Call pfLogEvent("Function: 'pfEmailByCDO' - Not Sent gbSendEmails set to
False")
    GoTo exithere
  End If

  ' get the params for this particular mailing
  Set rstParams = dbs.OpenRecordset("Select * from tblEmailCDOParams Where
ParamsID=18")
  With rstParams
    strFrom = !objMessageName & <myname at mydomain.com>   make sure you have
it in brackets
    'strSubject = !objMessageSubject ' your subject
    'strBody = !objMessageTextBody ' your text 
    'strAttachment = Nz(!objMessageAddAttachment, "") ' path for attachment
on drive
    strUserName = !objMessageConfigurationFieldsItemUserName ' pop account
name eg pop.gmail.com
    strPwd = "xxxxxxxx" ' password for the pop account
    strUseSSL = !objMessageConfigurationFieldsItemUseSSL    'False
    varPort = !cdoSendUsingPort'2
    varSendVia = !objMessageConfigurationFieldsItemDNSorIP ' eg
smtp.gmail.com
    varServerPort = !objMessageConfigurationFieldsItemPort    '25 for me
    varAuthenticate = !cdoBasic '1
    varSecs2Wait = !objMessageConfigurationFieldsItemSec2Wait    '60
  End With

  Set objMessage = CreateObject("CDO.Message")    ' Create the message
object.
  objMessage.from = "server at yourdoma.org" ' or whatever you want the
recipient to see
  objMessage.To = strTo 'email address
  objMessage.cc = strCC 'email address
  objMessage.bcc = strBCC 'email address
  objMessage.Subject = strSubject' your subject

  ' Now for the Message Options Part.
  objMessage.TextBody = strBody
  objMessage.AddAttachment strAttachment

 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendusing") = varPort
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpserver") = varSendVia
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpauthenticate") = varAuthenticate
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendusername") = strUserName
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/sendpassword") = strPwd
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpserverport") = varServerPort
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpusessl") = strUseSSL
 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/confi
guration/smtpconnectiontimeout") = varSecs2Wait
  objMessage.Configuration.Fields.Update    ' Update configuration
  If bDisplay Then
    MsgBox objMessage.GetStream.ReadText  ' Use to show the message.
  End If
  objMessage.Send  ' Send the message.
  DoEvents
  Call pfLogEvent("Function: 'pfEmailByCDO' - Completed OK")
exithere:
  Set dbs = Nothing: Set rstErr = Nothing
  Exit Function
errhandler:
  strErr = "pfEmailByCDO - Send Errors " & Err.Description
  If InStr(strErr, ConErrX) > 0 Then
    strErr = strErr & " No Email Sent"
  End If
  Debug.Print strErr
  Call pfLogEvent("Function: 'pfEmailByCDO' - SEND ERRORS " & strErr)
  GoTo exithere
End Function 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin at
Beach Access Software
Sent: Wednesday, August 01, 2007 12:49 PM
To: 'Access Developers discussion and problem solving'
Subject: [AccessD] SMTP or Outlook?

Dear List:

I am developing a legal matter tracking app for a client. One of the
features is to email reports on a regular schedule to clients regarding the
various matters being handled.  

We can go with either Outlook or SMTP.  There's already some SMTP code in
the app (legacy app) and I've got some code for Outlook.  

Outlook, of course, has the disadvantage of thae nag messages requiring you
to allow access to Outlook when sending from another app.  I get around this
by using Click Yes but that has a security problem, obviously, in that
malware could then use Outlook.  

BTW, this isn't just for in-house use - he intends to make this a product.

Any opinions?  Is there a third alternative?

MTIA

Rocky

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com