GregoryWest
Registered User.
- Local time
- Today, 08:23
- Joined
- Apr 13, 2014
- Messages
- 161
I have this VBA code:
--------------------------------------------------------------------------
Option Compare Database
Option Explicit
Private Const URL_CDOCONFIG As String = ""
Public Function SendEmail(ByVal sTo As String, ByVal sFrom As String, _
Optional ByVal sCC As String = "", Optional ByVal sBCC As String = "", _
Optional ByVal sSubject As String = "", Optional ByVal sBody As String = "", _
Optional ByVal sServer As String = "mail.shaw.ca", Optional ByVal iPort As Integer = 25, _
Optional ByVal sUsername As String = "", Optional ByVal sPassword As String = "", _
Optional ByVal iSendUsing As Integer = 2, Optional ByVal bAuthenticate As Boolean = False, _
Optional ByVal bUseSSL As Boolean = True, Optional ByVal iTimeout As Integer = 60) As Boolean
On Error Resume Next
Err.Clear
Dim cdomsg As Object
Set cdomsg = CreateObject("CDO.message")
If Err Then
Debug.Print Err.Description
SendEmail = False 'Message not sent
Else
With cdomsg
With .Configuration.Fields
.Item(URL_CDOCONFIG & "sendusing") = iSendUsing
.Item(URL_CDOCONFIG & "smtpserver") = sServer
.Item(URL_CDOCONFIG & "smptserverport") = iPort
.Item(URL_CDOCONFIG & "smtpauthenticate") = IIf(bAuthenticate, 1, 0)
.Item(URL_CDOCONFIG & "smtpusessl") = bUseSSL
.Item(URL_CDOCONFIG & "smtpconnectiontimeout") = iTimeout
.Item(URL_CDOCONFIG & "sendusername") = sUsername
.Item(URL_CDOCONFIG & "sendpassword") = sPassword
.Update
End With
.To = sTo
.From = sFrom
.CC = sCC
.BCC = sBCC
.Subject = sSubject
.TextBody = sBody
If Err Then
Debug.Print Err.Description
SendEmail = False 'Message not sent
Else
DoCmd.Hourglass True
.Send
DoCmd.Hourglass False
If Err Then
Debug.Print Err.Description
SendEmail = False 'Message not sent
Else
SendEmail = True 'Message sent
End If
End If
End With
Set cdomsg = Nothing
End If
End Function
--------------------------------------------------------------
It is being called with the following macro:
SendEmail("gregory.west@dbwsys.mb.ca","vba@dbwsys.mb.ca","","","Subject line","Body of eMail here")
But I get this error message.
The "SendUsing" configuration value is invalid.
Anyone know what I am doing wrong..... Most frustrating.
--------------------------------------------------------------------------
Option Compare Database
Option Explicit
Private Const URL_CDOCONFIG As String = ""
Public Function SendEmail(ByVal sTo As String, ByVal sFrom As String, _
Optional ByVal sCC As String = "", Optional ByVal sBCC As String = "", _
Optional ByVal sSubject As String = "", Optional ByVal sBody As String = "", _
Optional ByVal sServer As String = "mail.shaw.ca", Optional ByVal iPort As Integer = 25, _
Optional ByVal sUsername As String = "", Optional ByVal sPassword As String = "", _
Optional ByVal iSendUsing As Integer = 2, Optional ByVal bAuthenticate As Boolean = False, _
Optional ByVal bUseSSL As Boolean = True, Optional ByVal iTimeout As Integer = 60) As Boolean
On Error Resume Next
Err.Clear
Dim cdomsg As Object
Set cdomsg = CreateObject("CDO.message")
If Err Then
Debug.Print Err.Description
SendEmail = False 'Message not sent
Else
With cdomsg
With .Configuration.Fields
.Item(URL_CDOCONFIG & "sendusing") = iSendUsing
.Item(URL_CDOCONFIG & "smtpserver") = sServer
.Item(URL_CDOCONFIG & "smptserverport") = iPort
.Item(URL_CDOCONFIG & "smtpauthenticate") = IIf(bAuthenticate, 1, 0)
.Item(URL_CDOCONFIG & "smtpusessl") = bUseSSL
.Item(URL_CDOCONFIG & "smtpconnectiontimeout") = iTimeout
.Item(URL_CDOCONFIG & "sendusername") = sUsername
.Item(URL_CDOCONFIG & "sendpassword") = sPassword
.Update
End With
.To = sTo
.From = sFrom
.CC = sCC
.BCC = sBCC
.Subject = sSubject
.TextBody = sBody
If Err Then
Debug.Print Err.Description
SendEmail = False 'Message not sent
Else
DoCmd.Hourglass True
.Send
DoCmd.Hourglass False
If Err Then
Debug.Print Err.Description
SendEmail = False 'Message not sent
Else
SendEmail = True 'Message sent
End If
End If
End With
Set cdomsg = Nothing
End If
End Function
--------------------------------------------------------------
It is being called with the following macro:
SendEmail("gregory.west@dbwsys.mb.ca","vba@dbwsys.mb.ca","","","Subject line","Body of eMail here")
But I get this error message.
The "SendUsing" configuration value is invalid.
Anyone know what I am doing wrong..... Most frustrating.