scott56
03-26-2009, 02:13 PM
Hi,
I have an Excel application that is trying to send a CDO email message to myself when a user of the application registers.
The CDO message is being sent via my own mail server. Everything works fine if the user is on a standalone PC connected to the internet. But when it is a user connected via a proxy the creation of the CDO email is blocked and fails.
See the code below that I am using to create and send the CDO email message. Is there anything that I can add to this setup of the CDO message to enable it through a Proxy or initiate a validation of their Proxy account before attempting the send ?
Do you think I should be doing this another way ?
Sub CDOSendMail(strSMTPServerName As String, _
strSendUserName As String, _
strSendPassword As String, _
strServerPort As String, _
strReplyToAddress As String, _
strFromDetails As String, _
blnUseSSL As Boolean, _
strContactEmailAddress As String, _
streMailSubject As String, _
strEmailBody As String, _
blnEmailSent As Boolean)
'This routine will send an email to the domain and settings set by the user in the User Settings sheet
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Dim objMessage As Object
blnEmailSent = True
'Check that the eMail address we are about to use is valid
If Not IsEmailValid(strContactEmailAddress) Then
Call MessageDisplay("Error", "Invalid Email Address", strContactEmailAddress)
blnEmailSent = False
Exit Sub
End If
'If the user is connected to the internet then send the email message
If IsConnected = True Then
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = streMailSubject
objMessage.Sender = strSendUserName
objMessage.To = strContactEmailAddress
objMessage.TextBody = strEmailBody
objMessage.TextBody = objMessage.TextBody
If strFromDetails <> "Not Specified" Then objMessage.from = strFromDetails
If strReplyToAddress <> "Not Specified" Then objMessage.ReplyTo = strReplyToAddress
'Setup the email configuraiton information
With objMessage.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServerName
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSendUserName
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSendPassword
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strServerPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = blnUseSSL
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
'Everything is now ready for sending the email...Catch any errors in the Message send process
On Error Resume Next
objMessage.Send
If Err <> 0 Then
Call MessageDisplay("Error", "Send Mail Problem")
blnEmailSent = False
End If
Else
Call MessageDisplay("Error", "Send Mail Problem")
blnEmailSent = False
End If
Set objMessage = Nothing
End Sub
I have an Excel application that is trying to send a CDO email message to myself when a user of the application registers.
The CDO message is being sent via my own mail server. Everything works fine if the user is on a standalone PC connected to the internet. But when it is a user connected via a proxy the creation of the CDO email is blocked and fails.
See the code below that I am using to create and send the CDO email message. Is there anything that I can add to this setup of the CDO message to enable it through a Proxy or initiate a validation of their Proxy account before attempting the send ?
Do you think I should be doing this another way ?
Sub CDOSendMail(strSMTPServerName As String, _
strSendUserName As String, _
strSendPassword As String, _
strServerPort As String, _
strReplyToAddress As String, _
strFromDetails As String, _
blnUseSSL As Boolean, _
strContactEmailAddress As String, _
streMailSubject As String, _
strEmailBody As String, _
blnEmailSent As Boolean)
'This routine will send an email to the domain and settings set by the user in the User Settings sheet
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Dim objMessage As Object
blnEmailSent = True
'Check that the eMail address we are about to use is valid
If Not IsEmailValid(strContactEmailAddress) Then
Call MessageDisplay("Error", "Invalid Email Address", strContactEmailAddress)
blnEmailSent = False
Exit Sub
End If
'If the user is connected to the internet then send the email message
If IsConnected = True Then
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = streMailSubject
objMessage.Sender = strSendUserName
objMessage.To = strContactEmailAddress
objMessage.TextBody = strEmailBody
objMessage.TextBody = objMessage.TextBody
If strFromDetails <> "Not Specified" Then objMessage.from = strFromDetails
If strReplyToAddress <> "Not Specified" Then objMessage.ReplyTo = strReplyToAddress
'Setup the email configuraiton information
With objMessage.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServerName
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSendUserName
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSendPassword
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strServerPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = blnUseSSL
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
'Everything is now ready for sending the email...Catch any errors in the Message send process
On Error Resume Next
objMessage.Send
If Err <> 0 Then
Call MessageDisplay("Error", "Send Mail Problem")
blnEmailSent = False
End If
Else
Call MessageDisplay("Error", "Send Mail Problem")
blnEmailSent = False
End If
Set objMessage = Nothing
End Sub