Excel VBA - Send smtp email on office365 as another user

[Shawn Yates]

I am building a marketing email tool that will loop through and send an email to a list of addresses. Each address has one of our employees listed in the cell next to it. I finally have the email code working when the "From" is my email address, but when if I use another person's email address I get a run-time error saying:

"... The Server response was 550 5.7.60 SMTP; Client does not have permissions to send as this sender..."

We use office365 for our company email. I have gone into our account settings and given my login access to "send as" for each of the employees on our exchange server. As I mentioned, if I put my email address in the ".From" it works perfectly. See my code below. Any thoughts would be greatly appreciated.

Sub CDO_Mail_Small_Text()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant


    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")


        iConf.Load -1
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myusername@xxxxx.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Update
        End With


    strbody = "Testing"


    With iMsg
        Set .Configuration = iConf
        .To = "xxxx@xxxx.com"
        .CC = ""
        .BCC = ""
        .From = "xxxxx@xxxxx.com"
        .Subject = "Important message"
        .TextBody = strbody
        .Send
    End With


    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End Sub

 

[Shawn Yates]

I figured this out. For some reason, I had the "Send As" settings backward in our exchange server delegation settings. Each user had to have me added to their "Send As" setting an not all those users added to mine.