Link to home
Start Free TrialLog in
Avatar of Jeanette Durham
Jeanette DurhamFlag for United States of America

asked on

Problems with E-Mailing through VBA using CDO

Hello experts!

So here is our situation.  We have a Access database that has a utility to write up and send an email.  I have 2 different machines here both running Windows 2003 Server.  One of the machines this code works great.  Never had a problem with it.  But on the other machine, of course the one I need it to work on it, the code does not work at all and produces the following error:

There was an error.  Please hit the send button again to send the remaining emails.
The error was:  
-2147220973, The transport failed to connect to the server.:

When I do this on my other server, it works fine.  Thusly, I suspect my code is fine but there is some sort of configuration issue on the computer.  I have all mail accounts that are set up on the server that works set up on the server that doesn't work as far as I know as well.  Here is my code.


'this sends an email, receivers an email to send to, and the message text.  

Public Function SendAnEmail(trustorEmail$, amessageText$) As Boolean
    Dim sEmail$, sEmailText$, sAccountEmail$, sAccountPass$, sMsgText$, sMsgHTML$
    'Get Account Info
    sAccountEmail = ConfigSettings.GetUserConfig("AccountEmail")
    sAccountPass = ConfigSettings.GetUserConfig("AccountPassword")
    If sAccountEmail = "" Or sAccountPass = "" Then
        MsgBox "Invalid email account info, must have account to send from. Please set the fields <ReportAccountEmail> and " & _
            "<ReportAccountPassword> to set the approriate user info.", vbExclamation
        Exit Function
    End If
    If amessageText = "" Then Exit Function 'this means it didn't pull up any records to send
    Dim myEmail As New SendEmail
    'Setup and Send me an email
    Dim iNumSent As Integer
    With myEmail
        .AddRecipient trustorEmail
        .BodyHTML = Replace(amessageText, vbCrLf, "<br/>")
        .BodyText = amessageText
        .Subject = cEmailSubject
        .Sender = sAccountEmail
        .UserName = sAccountEmail
        .Password = sAccountPass
    End With
    iNumSent = myEmail.SendEmail  'Send it!
    If iNumSent > 0 Then
        SendAnEmail = True
    Else:  SendAnEmail = False
    End If
End Function


'this is the class that makes creates the cdo message

Option Compare Database

'This class was written by Jeffrey Durham on 2/5/2010
'It uses CDO to directly send email messages through the network to a remote SMTP server
'  It accepts a username and password for Authentication (for anonymous, don't supply them)

'Set the constants below to configure the defaults for the class to work on your computer
'  These values can also all be set through properties on this class

Private Const cDefaultSMTPServer$ = "smtpout.secureserver.net"
Private Const cDefaultSMTPPort = 3535
Private Const cDefaultTimeout = 60

'########## CDO Email Constants

'Send Message Using..
Private Const cdoSendUsingPickup = 1        'Sends message using pickup directory
Private Const cdoSendUsingPort = 2          'Sends message through network. Must use this to use Delivery Notification

'Security Settings
Private Const cdoAnonymous = 0              'Do not authenticate w/ server
Private Const cdoBasic = 1                  '(clear text) must supply user name + pass with config schema
Private Const cdoNTLM = 2                   'The current process security context is used to authenticate with the service

'DSN; Delivery Status Notifications
'Note: Sadly, I was unable to get this to work. Setting CDO.Message.DSNOptions to any of these values caused
'  the message not to be sent at all, no errors thrown
Private Const cdoDSNDefault = 0             'No DSN commands are issued
Private Const cdoDSNNever = 1               'No DSN commands are issued
Private Const cdoDSNFailure = 2             'Return a DSN if delivery fails
Private Const cdoDSNSuccess = 4             'Return a DSN if delivery succeeds
Private Const cdoDSNDelay = 8               'Return a DSN if delivery is delayed
Private Const cdoDSNSuccessFailOrDelay = 14 'Return a DSN if delivery succeeds, fails, or is delayed

'######### CLASS PROPERTIES

Private m_SMTPServer As String
Private m_SMTPPort As Integer               'This is the outgoing SMTP Server Port
Private m_Timeout As Integer                'How long before email times out
Private m_UserName As String                'SMTP Server Account Name <joe@shmoe.net>
Private m_Password As String                'SMTP Password used for authentication
Private m_Sender As String
Private m_Subject As String
Private m_BodyText As String
Private m_BodyHTML As String
Private m_bRequestReceipt As Boolean

Private m_colRecipients As Collection       'Stores list of recipient's addresses
Private m_colAttachments As Collection      'Stores list of file path names to send

Public Property Let SMTPServer(ByVal strSMTPServer As String)
    m_SMTPServer = strSMTPServer
End Property
Public Property Get SMTPServer() As String
    SMTPServer = m_SMTPServer
End Property

Public Property Let SMTPPort(ByVal intSMTPPort As Integer)
    m_SMTPPort = intSMTPPort
End Property
Public Property Get SMTPPort() As Integer
    SMTPPort = m_SMTPPort
End Property

Public Property Let TimeOut(ByVal intTimeout As Integer)
    m_Timeout = intTimeout
End Property
Public Property Get TimeOut() As Integer
    TimeOut = m_Timeout
End Property

Public Property Let UserName(ByVal strUserName As String)
    m_UserName = strUserName
End Property
Public Property Get UserName() As String
    UserName = m_UserName
End Property

Public Property Let Password(ByVal strPassword As String)
    m_Password = strPassword
End Property
Public Property Get Password() As String
    Password = m_Password
End Property

Public Property Let Sender(ByVal strSender As String)
    m_Sender = strSender
End Property
Public Property Get Sender() As String
    Sender = m_Sender
End Property

Public Property Let Subject(ByVal strSubject As String)
    m_Subject = strSubject
End Property
Public Property Get Subject() As String
    Subject = m_Subject
End Property

Public Property Let BodyText(ByVal strBodyText As String)
    m_BodyText = strBodyText
End Property
Public Property Get BodyText() As String
    BodyText = m_BodyText
End Property

Public Property Let BodyHTML(ByVal strBodyHTML As String)
    m_BodyHTML = strBodyHTML
End Property
Public Property Get BodyHTML() As String
    BodyHTML = m_BodyHTML
End Property

Public Property Let RequestReceipt(ByVal bRequestReceipt As Boolean)
    m_bRequestReceipt = bRequestReceipt
End Property
Public Property Get RequestReceipt() As Boolean
    RequestReceipt = m_bRequestReceipt
End Property

'######### CLASS EVENTS

Private Sub Class_Initialize()
    'Initialize Class Objects
    Set m_colRecipients = New Collection
    Set m_colAttachments = New Collection
   
    'Set Default Settings for Class Properties
    m_SMTPPort = cDefaultSMTPPort
    m_SMTPServer = cDefaultSMTPServer
    m_Timeout = cDefaultTimeout
End Sub

Private Sub Class_Terminate()
    'Destroy Class Objects
    Set m_colRecipients = Nothing
    Set m_colAttachments = Nothing
End Sub

'########## MAIN ROUTINE, SENDS EMAIL

Public Function SendEmail() As Long
    'Main Routine which sends out the Emails
    '  Returns the number of emails sent
    If m_colRecipients.Count = 0 Then Exit Function 'no emails? no send.
   
    Dim objMsg As Object, objConf As Object
    Set objConf = CreateObject("CDO.Configuration") 'all config scheme defined on http://schemas.microsoft.com/cdo/configuration/
    Dim Authenticate As Integer, bHasAttachments As Boolean
    Authenticate = IIf(m_UserName = "" And m_Password = "", cdoAnonymous, cdoBasic)
    bHasAttachments = m_colAttachments.Count > 0
   
    'Configure CDO Configuration for Authentication and Send Through a Network to remote SMTP Server
    Set objFlds = objConf.Fields
    With objFlds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = m_SMTPServer
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = m_Timeout
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = m_SMTPPort
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Authenticate
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = m_UserName
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = m_Password
        .Update
    End With
    Set objFlds = Nothing
   
    'myFuncs.UseAccessMeter "Sending emails.. (" & m_colRecipients.Count & ")", 0, m_colRecipients.Count
    Dim recipient As Variant, knt As Integer
    For Each recipient In m_colRecipients
        knt = knt + 1
       
        Set objMsg = CreateObject("CDO.Message")
        With objMsg
            Set .Configuration = objConf
            .To = recipient
            .From = m_Sender
            .Subject = m_Subject
            .TextBody = m_BodyText
            .HTMLBody = m_BodyHTML      'use .HTMLBody to send HTML email.
   
            'Add attachments
            If bHasAttachments = True Then
                Dim strAttach As Variant
                For Each strAttach In m_colAttachments
                    .AddAttachment strAttach
                Next
            End If
           
            If m_bRequestReceipt = True Then
                .Fields("urn:schemas:mailheader:return-receipt-to") = m_Sender
                .Fields.Update
            End If
       
            'Send the Email!
            'myFuncs.UseAccessMeter "Sending: " & recipient, knt
            On Error GoTo MyErrHandler
            .send
            On Error GoTo 0
            SendEmail = SendEmail + 1   'Returns the number of emails sent
           
        End With
        Set objMsg = Nothing
    Next
   
CleanupAndExit:
    Set objMsg = Nothing
    Set objConf = Nothing
    Exit Function
   
MyErrHandler:
    MsgBox "There was an error. Please hit the send button again to send the remaining emails." & _
        vbCrLf & "The Error was: " & vbCrLf & Err.Number & ", " & Err.Description, vbExclamation
    Err.Clear
    GoTo CleanupAndExit
End Function

'######### Add Recipients

Public Sub AddRecipient(ByVal sEmail$)
    m_colRecipients.Add sEmail
End Sub

'######### Add Attachments

Public Sub AddAttachment(ByVal sPathname$)
    m_colAttachments.Add sPathname
End Sub

</code>
Avatar of paulpp
paulpp
Flag of United States of America image

Hello,

Check you virus/malware software.  I had big problems with this since sending CDO will be interpereted as a worm attack.  
Avatar of Jeanette Durham

ASKER

I use Kaspersky and as far as I can tell its not blocking.  I added an exemption and it still doesn't work.  It is very possible that either SpyBot or Malwarebytes set a block at some point in time though, is there something in particular I should be looking for?
ASKER CERTIFIED SOLUTION
Avatar of paulpp
paulpp
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
*attack, not attach
You could also do some basic command line testing to see if you can access the SMTP port through the command prompt.  Check out this article.

http://support.microsoft.com/kb/153119

Thanks.
Okay,

disabled kaspersky, still didn't work.
disable firewall through our router, still didn't work.
rolled back all spybot auto protection things, still doesn't work.

Application Log shows no entries relating to SMTP.

The computer it works on is on the same server and they are more or less identically configured (the working one was replaced by the non-working one :P).  Is there a special account in the mail settings through server that I need to set up to get this to work?  
Okay,

Try the steps in this article.  Let me know if you are able to connect through line command

http://support.microsoft.com/kb/323350
I can connect through the line command to the server from which I want to send the email, and as I was following the directions from the article you just recommended, it let me get as far as the
rcptto:<emailgoesehere> part and then it returned the message:
553 Sorry, that domain isn't in my list of allowed rcpthosts.

But it did let me use the same email for the sender (just not the recipient), and I used a local account that we have set up on our local computer here for the address. So the email address I used should be valid afaik. Also, I wasn't able to connect on the port 25, but just like the code I posted, I was able to connect over port 3535.
I've been messing with this for some time and I came across another script, that sends through gmail. I tried it using my email account and it definitely worked. So now I'm thinking.. is the problem local to my computer or is it the server? We're using GoDaddy, btw to send these. Although I still don't understand why only this computer in the office the code to send fails.

Here's my code that amazingly worked for sending a message through gmail:

Option Compare Database

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

Public Sub TestEmail()

    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Testing CDO through GMail"
    objMessage.From = """Me"" <my-gmail-email>"
    objMessage.To = "<send-to-email>"
    objMessage.TextBody = "If you're reading this, this musta worked.."

'==This section provides the configuration information for the remote SMTP server.

    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    'Name or IP of Remote SMTP Server
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

    'Type of authentication, NONE, Basic (Base64 encoded), NTLM
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

    'Your UserID on the SMTP server
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "<my-gmail-email>"

    'Your password on the SMTP server
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "<my-pass>"

    'Server port (typically 25)
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

    'Use SSL for the connection (False or True)
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

    'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

    objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

    objMessage.Send

End Sub

So what do you think? Does being able to send through gmail but not godaddy indicate anything useful?

Thanks! ~Jeffrey
Ok, this is strange.

First off, I have been writing this assuming all errors are happening on command ".send" - if that is not true please let me know.

I know  computers are on same server, just to be sure are they going through the same router, and physical firewall.  They probably are, but just thought I would mention it.

Besides that I can only suspect there is some software blocking your transmision on that port.  Possibly server 2003 has some blocks up, but I did all my work on VISTA, Windows 7, and XP so I will be no help on setting it up.

You could also try a line command email program and try sending an email through that.  Blat is a good one - http://sourceforge.net/projects/blat/.

Check out this link for some information on SMTP blocking from SBServer 2003.  Sorry I am kind of at the length of my experience now.  I know how frustrating it is, and have dealt with this for many hours.
If there is anything else I can do let me know.  Thanks.

http://www.msexchange.org/tutorials/Microsoft-Small-Business-Server-2003-Spam-Filtering.html
Hello,

Ok, this one has me beat.  There is no reason why it would work on one computer and not the other based on the server you are sending through, unless for some reason Go Daddy blocked the ip address for the new computer.  Very strange indeed.

I hope the new code will work for you.  If you ever figure out what it was drop me a line, because I am sure one day I will run into this problem also.  Thanks.
Yeah I'm out of ideas for this one too for now.. to answer your earlier questions, sorry the workday ended so I went home :), you are correct that is definitely happening on the .Send command, and they are going through the same router. They are also on the same network and have the same external ip address, as well as same physical firewall. The firewall on the computer itself is turned off, so I guess our only firewall is through the router config. I think that the most likely answer is that it is software on the computer that is blocking it (it's gotta be..), since the other computer works fine with goDaddy and it's on the same network. I'll let you know if I can figure it out, maybe I missed something when trying to narrow it down earlier. I was also trying to figure out how to install the Blat, it would be interesting to try another program to send it just to see how that went and if anything could be learned from it, but so far the instructions in the readme file aren't really making sense.. I think they're for an older version of windows. Hope your day is going well, I'll let you know if I make any progress on the issue. Thanks! ~Jeffrey
I downloaded a tool from microsoft, SMTPDiag and ran it. It failed at a some different points and I'm not sure if these might explain the issue, I'm not really sure how to interpret it, but they were:

Searching for Exchange external DNS settings.
Computer name is IONSERVER.
Failed to connect to the domain controller. Error: 8007054b

Checking TCP/UDP SOA serial number using DNS server [192.168.1.1].
TCP test failed.

And then on the part where it check local domain records..
Checking MX records using TCP: iondataexpress.com.
Warning: The TCP DNS query returned no results.

And then on the part where it checks remote domain records..
Checking MX records using TCP: hotmail.com.
Warning: The TCP DNS query returned no results.

Now, I think on these tests I did, that it was trying to go through smtpout.secureserver.net so that was through GoDaddy but I didn't know how to set the port, so it tested by default on 25. I think it's supposed to be 3535.. but do these results actually perhaps reveal the problem? ~Jeffrey

Also another thing I was wondering was, does it matter if the tcp dns queries fail as long as the udp queries succeed?
D:\Michael's\SmtpDiag>smtpdiag "reports@iondataexpress.com" "michael@iondataexpr
ess.com"

Searching for Exchange external DNS settings.
Computer name is IONSERVER.
Failed to connect to the domain controller. Error: 8007054b

Checking SOA for iondataexpress.com.
Checking external DNS servers.
Checking internal DNS servers.
SOA serial number match: Passed.

Checking local domain records.
Checking MX records using TCP: iondataexpress.com.
Warning: The TCP DNS query returned no results.
Checking MX records using UDP: iondataexpress.com.

Checking remote domain records.
Checking MX records using TCP: iondataexpress.com.
Warning: The TCP DNS query returned no results.
Checking MX records using UDP: iondataexpress.com.

Checking MX servers listed for michael@iondataexpress.com.
Connecting to smtp.secureserver.net [216.69.186.201] on port 25.
Connecting to the server failed. Error: 10060
Failed to submit mail to smtp.secureserver.net.


D:\Michael's\SmtpDiag>smtpdiag "reports@iondataexpress.com" "jeffrey_durham@hotm
ail.com" /v

Searching for Exchange external DNS settings.
Computer name is IONSERVER.
Failed to connect to the domain controller. Error: 8007054b

Checking SOA for hotmail.com.
Checking external DNS servers.
Checking internal DNS servers.

Checking TCP/UDP SOA serial number using DNS server [192.168.1.1].
TCP test failed.
UDP test succeeded.
Serial number: 2011051401
SOA serial number match: Passed.

Checking local domain records.
Starting TCP and UDP DNS queries for the local domain. This test will try to
validate that DNS is set up correctly for inbound mail. This test can fail for
3 reasons.
    1) Local domain is not set up in DNS. Inbound mail cannot be routed to
local mailboxes.
    2) Firewall blocks TCP/UDP DNS queries. This will not affect inbound mail,
but will affect outbound mail.
    3) Internal DNS is unaware of external DNS settings. This is a valid
configuration for certain topologies.
Checking MX records using TCP: iondataexpress.com.
Warning: The TCP DNS query returned no results.
Checking MX records using UDP: iondataexpress.com.
  MX:    smtp.secureserver.net (0)

Checking remote domain records.
Starting TCP and UDP DNS queries for the remote domain. This test will try to
validate that DNS is set up correctly for outbound mail. This test can fail for
3 reasons.
    1) Firewall blocks TCP/UDP queries which will block outbound mail. Windows
2000/NT Server requires TCP DNS queries. Windows Server 2003 will use UDP
queries first, then fall back to TCP queries.
    2) Internal DNS does not know how to query external domains. You must
either use an external DNS server or configure DNS server to query external
domains.
    3) Remote domain does not exist. Failure is expected.
Checking MX records using TCP: hotmail.com.
Warning: The TCP DNS query returned no results.
Checking MX records using UDP: hotmail.com.
  MX:    mx1.hotmail.com (5)
  MX:    mx2.hotmail.com (5)
  MX:    mx3.hotmail.com (5)
  MX:    mx4.hotmail.com (5)
  A:     mx1.hotmail.com [65.55.92.168]
	.. many more of the same kinda thing listed here, guess hotmail has dozens of these

Checking MX servers listed for jeffrey_durham@hotmail.com.
Connecting to mx4.hotmail.com [65.54.188.94] on port 25.
Connecting to the server failed. Error: 10060
	..and then it repeats and tries each different ip for hotmail, they all fail with same

Open in new window

Hello,

It doesnt matter if it is using TCP or UDP because they are both being blocked by  firewall possibly.

   1) Firewall blocks TCP/UDP queries which will block outbound mail. Windows
2000/NT Server requires TCP DNS queries. Windows Server 2003 will use UDP
queries first, then fall back to TCP queries.

Google the line I pasted above.  There are some known Reverse DNS issues with server 2003.  Here is the first one I found.  None of this explains why it will work with one server and not the other

http://social.technet.microsoft.com/Forums/en-IE/exchangesvrtransport/thread/fb00ade3-4ba0-4c80-912a-da80ff42a9b4

Let me know where that puts you.
Ok it took me awhile to figure out all the command line switches, but this is rather interesting. I was able to finally send an email through the computer that isn't working - through Blat. I used the smtpout.secureserver.net and the port 3535 and the correct email account and password. So.. that is fascinating. I'm going to go mess with the vb side again.. another interesting note is I can configure outlook express and it will also send and receive to that account. So whatever is blocking it or whatever is going on actually seems to be limited to vb6. But that Blat program is pretty cool! Worst case I can just call that up and send emails that way programmatically no problem.. ~Jeffrey
Not sure what is now different, but I'm revisiting the vb side of it (I'm actually using vba through access, I said vb6 cause I write in that too, but technically, it's vba) and now I've got a new error message when I try to send..

it is: The server rejected one or more recipient addresses. The server response was: 553 Sorry, that domain isn't in my list of allowed rcpthosts.

I'm researching this now..
~Jeffrey
Ok we can't remember all the different things we tried, but now for some reason it is working. It might have been that we rolled back the spybot immunization, or maybe it was something I did while messing with it all day or maybe it was rebooting it or installing blat (but I really doubt that that's what it was..) but now it is working. The last error I just got turned out to be because I forgot to include a password in my test code, but once I fixed that, my code is working again. So I'm glad to say that somehow it got fixed, but I really can't figure out why.. Tomorrow I think I'll reapply the spybot immunization and reboot and see if it breaks again. If so then I will know for certain that that was it. After I try that, I'll post one final comment and let you know if that's what it was. I'll also pick whichever comment seems to be most applicable to what the issue was and give you the credit, as you surely deserve it for all your help!

But at least it's working now! Thanks for all your help PaulPP. Sorry this seemed like a wild goose chase..

~Jeffrey
Great, I know the pain of dealing with CDO and it not going through, so I was really just happy to have all my pain be useful to someone else :).  Good luck and happy programing.