Max Wanadoo
max.wanadoo at gmail.com
Wed Mar 3 08:38:48 CST 2010
Just a suggestion, but why dont you use BOTH and then if one stops, just
swap to the other.
I know that the 3 examples I posted all work when the correct smtp
connections are entered including the one for Google.
I havent tried Dan's and that should be ok once the authentication is
overcome but having both means you can switch to your own server or Google
server or client server at the drop of the proverbial hat.
The CDO code has been sending me emails every single night for about 8 years
of so on the outcome of the nightly backups and creation of web site
content. never missed. No Registration and runs immediately and has
attachments. Not shown in the code I posted, but it actually takes it
recipients source from a table and write an event log to a table too. It is
ideal if you want a distribution list or newletter list etc.
max
On 3 March 2010 14:21, Rocky Smolin <rockysmolin at bchacc.com> wrote:
> Max:
>
> Thanks for the code. I may use that instead of the existing code as it
> looks like the problem may not have been my code or CDO but authentication.
> Using the vbSendMail that Dan pointed me to, I was able to raise the error
> event and it appeared to be an authentication problem. If so, then the
> network guy should have some input for us.
>
> I see in your code, however, a comment on what the authentication constants
> are. The original CDO code used Basic. I'm wondering if one of the others
> might work.
>
> Rocky
>
>
> -----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
>