Function to send email fails.

Hi Experts,

We have the following function that used to work for years, now suddenly its starting to cause problems.

Public Sub SendEmail(Optional sTo As String = "", Optional sFrom As String = "", Optional sSubject As String = "", Optional sBody As String = "")
    Dim imsg As Object
    Dim iconf As Object
    Dim flds As Object
    Dim schema As String

    Set imsg = CreateObject("CDO.Message")
    Set iconf = CreateObject("CDO.Configuration")
    Set flds = iconf.Fields

    ' send one copy with SMTP server (with autentication)
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    flds.Item(schema & "sendusing") = cdoSendUsingPort
    flds.Item(schema & "smtpserver") = "smtpout.secureserver.net."
    flds.Item(schema & "smtpserverport") = 3535
    flds.Item(schema & "smtpauthenticate") = cdoBasic

    flds.Item(schema & "sendusername") = "MyEmail@MyDomain.net"
    flds.Item(schema & "sendpassword") = "MyPWD"
    flds.Item(schema & "smtpusessl") = False
    flds.Update

    With imsg
        .To = sTo
        .From = sFrom
        .Subject = sSubject
        .HTMLBody = sBody
       '.Sender = "Sender"
        '.Organization = "My Company"
        '.ReplyTo = "address@mycompany.com"
        Set .Configuration = iconf
        .send
    End With

    Set iconf = Nothing
    Set imsg = Nothing
    Set flds = Nothing
End Sub

Open in new window


See attached error message.
Untitled.png
LVL 5
bfuchsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Wayne88Commented:
The error message seems like the SMTP communication was blocked because of:

1.  Local firewall is blocking it
2.  Relaying is disabled.  Can you verify with the email administrator that relaying is allowed?  
3.  Email server firewall is blocking it
0
John TsioumprisSoftware & Systems EngineerCommented:
Have you changed something in the email configuration ..e.g version of Exchange server..Exchange 2016 doen't work with CDO.
EDIT..i see you use GoDaddy email functionality...maybe you should drop them a ticket to see is something needs to be done.
0
bfuchsAuthor Commented:
Hi Experts,
Have you changed something in the email configuration ..e.g version of Exchange server
Yeah, guess this was working till now while our GoDaddy account was still active...
Wondering what needs to be changed in order to work.
Exchange 2016 doen't work with CDO.
I see from the following it should work.
https://community.smartbear.com/t5/TestComplete-Desktop-Testing/sending-mail-via-CDO-and-office365-com/td-p/132282

BTW, I'm open for other suggestions, not bounded to CDO (as long as they work and easy to apply/maintain..).

Thanks,
Ben
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

Wayne88Commented:
Since you mentioned Go Daddy, are you using hosted Exchange or on-site?
0
bfuchsAuthor Commented:
Since you mentioned Go Daddy
Oh forgot to mention..We changed for Office 365.
Thanks,
Ben
0
Wayne88Commented:
If you changed to Office 365 then it is probably because email relaying is not configured.  Please have a look at these articles:

https://support.office.com/en-us/article/how-to-set-up-a-multifunction-device-or-application-to-send-email-using-office-365-69f58e99-c550-4274-ad18-c805d654b4c4?ui=en-US&rs=en-US&ad=US#option1

http://office365support.ca/smtp-relay-with-office-365/

It's best to call Office 365 support and they should help you with this.
0
bfuchsAuthor Commented:
I changed for the following
    flds.Item(schema & "smtpserver") = "whiteglovecare-net.mail.protection.outlook.com"
    flds.Item(schema & "smtpserverport") = 25
   ' flds.Item(schema & "smtpauthenticate") = 0

Open in new window

Then we got the attached.
Went online to enlist the IP and it worked.
but after testing 2 times I'm getting the attached msg again..
What are my options?

Thanks,
Ben
Untitled.png
0
Wayne88Commented:
IMHO, the message strictly refers to "banned sending IP" so it seems as the Office 365 is blocking it because it's suspicious of your script trying to flood the system with emails (spam).
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bfuchsAuthor Commented:
Thank you my experts!
0
Wayne88Commented:
You're welcome and glad to help.  Cheers!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
System Programming

From novice to tech pro — start learning today.