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