[AccessD] Email problem. Again

Max Wanadoo max.wanadoo at gmail.com
Wed Mar 3 11:37:53 CST 2010


 > That's the reason we started using Redemption years ago

Exactly, Charlotte.  Years ago.  And it is still here after all that  worry!

I was going  to stop developing in A2k3  years ago thinking it would be
around much longer  and not only is  A2k3 still here  but people are  still
developing in A97!

CDO will be around as long as A2k3 databases are around.   And if  the day
comes, handle it  then.
I have been  using  it  for years and  before that cdos.

But, I also use minirelay and send  directly from my PC.

Max

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Charlotte Foust
Sent: 03 March 2010 16:24
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Email problem. Again

Max,

The problem with CDO is that it may not be there.  That's the reason we
started using Redemption years ago.  CDO is no longer installed with Windows
or with Office.  If the user doesn't take steps to install it, it won't be
available.

Charlotte Foust

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Max Wanadoo
Sent: Wednesday, March 03, 2010 2:40 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Email problem. Again

Here are THREE examples that work using CDO.  Nothing to Register, just
replace the examples with real data.

Max

Option Compare Database
Option Explicit
' intServerPort could be 587  or 465 but usually 25 ' intAuthenticate can be
0 = Anonymous, 1 = Basic 2= cdoNTLM, 3 = cdoMessage Sub SendVia1()
    Call pfEmailByCDO( _
         strFrom:="Server <Server at myserver.com>", _
         strSubject:="My Subject", _
         strBody:="My Body", _
         strTo:="my.client at client.com;secretary at client.com", _
         strCC:="", _
         strBCC:="", _
         strSMTPServer:="mail.myserver.com", _
         strSMTPUserName:="server at myserver.com", _
         strSMTPPwd:="mysecretpassword", _
         strUsesSSL:="False", _
         bDisplay:=True, _
         intPort:=2, _
         intServerPort:=25, _
         intAuthenticate:=1, _
         intSecs2Wait:=60, _
         strAttachment:="c:\MyTest.txt") End Sub Sub SendVia2()
    Call pfEmailByCDO( _
         strFrom:="Developer <great.stuff at developers.com>", _
         strSubject:="My Subject", _
         strBody:="My Body", _
         strTo:="my.client at client.com", _
         strCC:="", _
         strBCC:="", _
         strSMTPServer:="smtp.developers.com", _
         strSMTPUserName:="great.stuff at developers.com", _
         strSMTPPwd:="mysecretpassword", _
         strUsesSSL:="False", _
         bDisplay:=True, _
         intPort:=2, _
         intServerPort:=25, _
         intAuthenticate:=1, _
         intSecs2Wait:=60, _
         strAttachment:="c:\MyTest.txt") End Sub Sub SendViaGoogle()
    Call pfEmailByCDO( _
         strFrom:="My Google <me.google at googlemail.com>", _
         strSubject:="My Google Subject", _
         strBody:="My Body", _
         strTo:="my.client at client.com", _
         strCC:="", _
         strBCC:="", _
         strSMTPServer:="smtp.gmail.com", _
         strSMTPUserName:="me.google", _
         strSMTPPwd:="mysecretpassword", _
         strUsesSSL:="true", _
         bDisplay:=True, _
         intPort:=2, _
         intServerPort:=465, _
         intAuthenticate:=1, _
         intSecs2Wait:=60, _
         strAttachment:="c:\MyTest.txt") End Sub

Public Function pfEmailByCDO(strFrom As String, strSubject As String,
strBody As String, _
                             strTo As String, strCC As String, strBCC As
String, _
                             strSMTPServer, strSMTPUserName, strSMTPPwd,
strUsesSSL, _
                             intPort, intServerPort, intAuthenticate,
intSecs2Wait, _
                             bDisplay As Boolean, Optional strAttachment As
String)
    On Error GoTo errhandler
    Const conErr1 As String = "The SMTP server rejected one or more
recipient addresses. Response was: 550 "
    Const conErr2 As String = "The SMTP server rejected one or more
recipient addresses. Response was: 501 bad address syntax: <"
    Const ConErrX As String = "The transport failed to connect to the SMTP
server"
    Dim strErr As String
    Dim objMessage
    Set objMessage = CreateObject("CDO.Message")    ' Create the message
object.
    objMessage.from = strFrom
    objMessage.To = strTo
    objMessage.cc = strCC
    objMessage.bcc = strBCC
    objMessage.Subject = strSubject
    ' Now for the Message Options Part.
    objMessage.TextBody = strBody
    objMessage.AddAttachment strAttachment
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/sendusername") =
strSMTPUserName
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSMTPPwd
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpusessl") = strUsesSSL
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpserverport") =
intServerPort
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") =
intAuthenticate
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/sendusing") = intPort
    objMessage.Configuration.Fields.Item("
http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") =
intSecs2Wait
    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
exithere:
    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
    MsgBox strErr
    GoTo exithere
End Function
Private Function fFileContents(strFilePath As String) As String 'These
constants are defined to make the code more readable
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Open the file for reading
    Set f = fso.OpenTextFile(strFilePath, ForReading)
    'The ReadAll method reads the entire file
    fFileContents = f.ReadAll
    f.Close    'Close the file
    Set f = Nothing
    Set fso = Nothing
End Function
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

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




More information about the AccessD mailing list