CDO return address question (1 Viewer)

[ellenr]

My cdo routine written several years ago, allowed the user to specify a return email address that could be different from the sending address. Now, that is no longer working in my code--if the two addesses are different, it thinks it sent correctly but never show up in the recipient's inbox. Is there a work-around or do I just have to specify that the user use the same address?

 

[oleronesoftwares]

My cdo routine written several years ago, allowed the user to specify a return email address that could be different from the sending address. Now, that is no longer working in my code--if the two addesses are different, it thinks it sent correctly but never show up in the recipient's inbox. Is there a work-around or do I just have to specify that the user use the same address?

Do share the code
Also when last did it work well, and what modification did u make on it before it stopped working?

 

[ellenr]

The following is the description of the program's email functions: Member data for this organization reside in a table which contains a checkbox that will include that person in the upcoming email when checked. The email form itself contains blanks for sender name, the reply email address, subject of the email, optional browse button for an attachment and the body of the email. The sender then selects her name from previously entered sending email credentials (email address, password, SMTP outgoing server, port, SSL, Auth). After clicking the send email button, the code sends to each member whose Send Email box is checked, after which it puts it in the sent emails table, each of which is marked "sent" or "failed". The last time entering a separate return email address worked was probably a couple of years ago. It worked when I originally wrote it, but I am not the main user of the program so I cannot pinpoint when it quite working exactly.

Here is my code:

Private Function Command67Send()
On Error GoTo errRoutine
Dim dbs As Database
   Set dbs = CurrentDb()
Dim rstSendinvites As Recordset
Dim sname As String, sEmail As String, sinvitsentdate As String, sSent As String
Dim sServer As String, sSenderEmail As String, sSenderPassword As String, sSendError As String
Dim iInvitsent As Integer, iSendinvite As Integer, jk As Integer
Set rstSendinvites = dbs.OpenRecordset("sendinvites", dbOpenDynaset)
DoCmd.Hourglass (-1)
Dim sFromField As String, sReplytoEmailAdd As String, sSubjectLine As String, _
    sAttachmentLocation As String, sAttach As String, sBody As String, strbody As String, sbounce As String
    
If Me.Dirty Then Me.Dirty = False   'force save current record

    sFromField = Me.FromField
    sReplytoEmailAddr = Me.ReplyToEmailAddr
    sSubjectLine = Me.SubjectLine
    If Not IsNull(Me.AttachmentLocation) Then sAttachmentLocation = Me.AttachmentLocation
    If InStr(sAttachmentLocation, ";") > 0 Then
        sAttach = Trim(Mid(sAttachmentLocation, InStr(sAttachmentLocation, ";") + 1))
        sAttachmentLocation = Trim(Left(sAttachmentLocation, InStr(sAttachmentLocation, ";") - 1))
    End If
    On Error GoTo 0
    If IsNull(Me.Body) Then          'to circumvent "Invalid null" error bomb out.  Whoever sends an email with empty body?
        Me.Body = "."
        sBody = "."
    Else
        sBody = Me.Body
    End If

    sServer = Me.MoSender             'sender credentials picked up from registration file
    sSenderEmail = Me.MoEmail
    sSenderPassword = Me.MoPassword
    sPort = Me.MoPort
    
    sSSL = True
    If Me.MoSSL = 0 Then sSSL = False


    sAuth = True
    If Me.MoAuth = 0 Then sAuth = False
    
Dim objMsg As Object
Dim objConf As Object
Dim objFlds As Object

Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay''

Set objMsg = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")

Set objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sServer
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = sPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = sAuth
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = sSSL
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sSenderEmail
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sSenderPassword
  .Update
End With

Dim messageTrigger As Integer
messageTrigger = 0
Dim rstEmailLog As Recordset
Set rstEmailLog = dbs.OpenRecordset("EmailLog", dbOpenDynaset)
With rstSendinvites
    If Len(sAttachmentLocation) > 0 Then objMsg.AddAttachment sAttachmentLocation
    If Len(sAttach) > 0 Then objMsg.AddAttachment sAttach   'add second attachment
    Do While Not .EOF
        sname = .Fields("namealpha")
        snameKEEP = .Fields("namealpha")
        mName = .Fields("propername")
        sname = Mid$(sname, InStr(sname, ",") + 2)
        sEmail = .Fields("emailaddr")
        sbounce = Me.Mobounce
        strbody = sBody
                      
        Dim strHTML
        strHTML = "<FONT Face='Comic Sans MS' Size=3>Dear " & sname & ",<br><br>" & strbody & "</font>"
        strHTML = strHTML & "</BODY></HTML>"
'    sServer = Me.MoSender             'sender credentials picked up from registration file
'    sSenderEmail = Me.MoEmail
'    sFromField = Me.FromField                   Sender's name from email setup screen
'    sReplytoEmailAddr = Me.ReplyToEmailAddr     Reply to email addr from email setup screen
                With objMsg
                  Set .Configuration = objConf
                  .To = sEmail
                  .from = sFromField & " <" & sReplytoEmailAddr & ">"
                  .sender = sReplytoEmailAddr
                  .ReplyTo = sReplytoEmailAddr
                  .Subject = sSubjectLine
                  .htmlbody = strHTML

                  On Error Resume Next
                  .Send
                        sSent = "Sent"
                        If err.Number <> 0 Then
                            sSent = "Failed"   'this is the log entry
                            messageTrigger = -1
                            .To = Me.ReplyToEmailAddr
                            .Subject = "Delivery Failure to " & mName
                            .htmlbody = "Email to " & mName & "  Failed:  " & Error$
                            strHTML = "Email to " & mName & "  Failed:  " & Error$
                            .Send
                            On Error GoTo errRoutine
                            GoTo skipper 'skip record update to uncheck sendemail box
                        End If
                   On Error GoTo errRoutine
                End With
                                        
        .Edit
        .Fields("sendemail") = 0
        .Update
skipper: With rstEmailLog
            .AddNew
            .Fields("FromField") = sFromField
            .Fields("Sent") = sSent
            .Fields("ReplyToaddr") = sReplytoEmailAddr
            .Fields("SendToaddr") = sEmail
            .Fields("SubjField") = sSubjectLine
            .Fields("BodyField") = strHTML
            .Fields("MemberName") = snameKEEP
            .Fields("Attachment") = sAttachmentLocation
            .Fields("Screen") = "Invites"
            .Fields("EmailClient") = sSenderEmail
            .Fields("smtp") = sServer
            .Fields("usedSSL") = sSSL
            .Fields("usedAUTH") = sAuth
            .Fields("usedPort") = sPort
            .Update
        End With
        If InStr("strbody", "transport") > 0 Then
            MsgBox "Lost Transport connection--Press Send Email button again.", vbInformation, "Caution!"
            GoTo results_Exit
        End If
        .MoveNext
    Loop
End With

DoCmd.Close acForm, "EmailSetupJean", acSaveYes
results_Exit:
    Set objMsg = Nothing
    Set rstEmailLog = Nothing
    Set rstSendinvites = Nothing
    If messageTrigger Then
        MsgBox "Check Email Log for Failed Email Addresses", vbInformation, "Caution!"
    End If
    DoCmd.Hourglass (0)
    Exit Function

errRoutine:
    If err = -2147024894 Then
        MsgBox "The system cannot find the attachment file.", vbInformation, "Caution!"
    Else
        MsgBox Error$
    End If
    Resume results_Exit
End Function

 

[The_Doc_Man]

How recently did this stop working? We've been getting a rash of issues due to a recent Microsoft patch that seems to have wide-ranging security issues. Check the date of your most recent MS patch from the Windows Update page. See if it was recent enough that you can roll it back and try your CDO program with the pre-patched system.

 

[oleronesoftwares]

it thinks it sent correctly but never show up in the recipient's inbox

By recipient do you me the email addresses in the To field or the Sender's Email address?

 

[Minty]

@isladogs Has used CDO extensively, I've popped his user tag in here to see if he can pick up on the problem.

 

[Gasman]

Well I would log in as that user, if they can process or get data differently, and then walk through the code line by line.?

If it is not an update problem, then could be a data problem?
Does Me.ReplyToEmailAddr even have a value?

 

[gemma-the-husky]

We send a copy of sent emails to an admin address so we have a record of them. At least it shows the process is working.

 

[ellenr]

oleronesoftwares, The recipient is the address in the To field. The recipient never receives the email although the code never gets a fail indicator. If, however, the sending email credentials email address is the same as the Reply To address, all works correctly and the email is delivered. Sorry about the bold type, I cannot seem to unBold it.

 

[Gasman]

You highlight all the bold text then press bold icon

 

[ellenr]

Gasman, I do know the code executes to the end and exits because the list of sent emails saved at the bottom of the code contains both the successful and the unsuccessful emails. me.ReplyToEmailAddr has a value picked up from the input screen along with the Subject, Attachment (if any) and the body of the email. So long as me.sReplyToEmailAddr matches the sending credentials it works. Originally, one person could do the work of designing and sending invitations, for example, and enter another person's address for the return answers. Getting this to work is not a big deal, just a nice ability for the code that used to work and wondering why it won't now.

 

[ellenr]

You highlight all the bold text then press bold icon

Tried that.

 

[Minty]

My only thought is that the permissions have been changed in the background on that / those accounts being specified in the reply to address?

 

[Gasman]

From a quick google

Sending mail with CDO through a remote SMTP server - problem with Reply To address [SOLVED]

I want to send emails from VBA using the CDO functionality. I have used the method described by Ron De Bruin successfully in the past but only using my local SMTP server. I now need to do the same with a remote server, such as Gmail. I found something potentially suitable in the...

www.excelforum.com

 

[The_Doc_Man]

When I have had issues with the CDO send-mail method (which is strictly SMTP) and it wasn't because of any procedural error on my part, it has usually been because my site's IT staff had some kind of filter on the SMTP gateway router that looked into the header of the messages. If you have an active IT group, ask them if they are seeing some rejected messages due to improper sender credentials. If not, then I'm not sure what is next, but if they HAVE set up blockages, your next step will be with the IT security folks.

 

[theDBguy]

Tried that.

Fixed it for you.

 

[ellenr]

Thanks, theDBguy.

 

[sonic8]

... code that used to work and wondering why it won't now.

You're barking up the wrong tree.
Your code still works! What may have changed are the rules of email delivery to the recipients.
A reply-to address different from the sender address may be considered an indicator of spam by some email processing component along the way. This may lead to your email being classified as spam or even discarded entirely. - Of course this is a problem, but it has nothing to do with the VBA code for sending the email.

If sender and recipients are within the same organization, you could try to find out what exactly happens to prevent the email from being delivered to the recipients inbox (e.g. look in the spam folders, contact email admins to check log files). Then ask the user and/or admins to change the configuration that causes the problem.
If the recipients are external, then there is little you can do. Just change the code to not allow differing reply-to addresses.

 

[isladogs]

Just spotted the alert that Minty posted yesterday.

In about 15 years working almost exclusively with CDO, I don't think I've ever had a reason to have a different reply and sender address.
What I often do is specify the sender address (which can be different from your actual address) to be the address to reply to.
That definitely works providing you specify a real address.
It can also be used for the no reply type email addresses that are widely used by many companies

 

[ellenr]

When I have had issues with the CDO send-mail method (which is strictly SMTP) and it wasn't because of any procedural error on my part, it has usually been because my site's IT staff had some kind of filter on the SMTP gateway router that looked into the header of the messages. If you have an active IT group, ask them if they are seeing some rejected messages due to improper sender credentials. If not, then I'm not sure what is next, but if they HAVE set up blockages, your next step will be with the IT security folks.

You're barking up the wrong tree.
Your code still works! What may have changed are the rules of email delivery to the recipients.
A reply-to address different from the sender address may be considered an indicator of spam by some email processing component along the way. This may lead to your email being classified as spam or even discarded entirely. - Of course this is a problem, but it has nothing to do with the VBA code for sending the email.

If sender and recipients are within the same organization, you could try to find out what exactly happens to prevent the email from being delivered to the recipients inbox (e.g. look in the spam folders, contact email admins to check log files). Then ask the user and/or admins to change the configuration that causes the problem.
If the recipients are external, then there is little you can do. Just change the code to not allow differing reply-to addresses.

I think this isn't worth the worry! I shall just remove the option to specify the reply address. If they want to specify a different reply address they can put it into their message. Thank all of you for your help.