MS Access, VBA, Sending Reports via Email

Hello,

I'm currently using the attached code to send a report via email using MS Access.  The code works great as long as I'm sending to internal email addresses; however, when I try sending to any outside email addresses I get the following error:

Run-time error '-2147220977(8004020F)':

The server rejected one or more recipient addresses.  The server reponse was: 550 5.7.1 Unable to relay for Tianahood@me.com.

I've attached the actual error for reference.  It seems that I'm going to need some additional permission;however, our IT department is somewhat limited so I would like to get an idea of what they need to do before I approach them with the issue.
Sub Franchise_Reports()

DoCmd.OpenQuery "Q_FranchiseEmail_Query1", acViewNormal
DoCmd.OpenTable "T_FranchiseEmail_TempTable1", acViewNormal


    Dim MyDB As Database, RS As Recordset
    Dim lngCount As Long, lngRSCount As Long
    

    Set MyDB = CurrentDb

      Set RS = MyDB.OpenRecordset _
      ("T_FranchiseEmail_TempTable1")
    
    
    lngRSCount = RS.RecordCount
        If lngRSCount = 0 Then
        MsgBox "No Franchisee Records for Period Selected", vbInformation
        Else
    
      RS.MoveLast
      RS.MoveFirst
      
      Dim WkEnd As Variant
      Dim ENName As String
      Dim ENNum As Variant
      Dim Email As String
      Dim Contact As String
      
      Dim Mypath As String
      Dim Myfilename As String
      Dim MySubject As String
      
      Do Until RS.EOF
        WkEnd = RS.Fields("WkEnd")
        WkEnd = Text_to_Date(WkEnd)
        ENName = RS.Fields("EntityName")
        ENNum = RS.Fields("EntityID")
        Email = RS.Fields("AcctContactEmail")
        Contact = RS.Fields("AcctContactFirstName")
        
        Mypath = "S:\Accounting\03 IconBurger(SmashBurger)\MAS Scanned Documentation\Franchisee Reports\"
        Myfilename = WkEnd & "-" & ENName & " Weekly Franchise Fees.html"
        MySubject = WkEnd & "-" & ENName & " Weekly Franchise Fees"
        DoCmd.OpenForm "F_FranchiseeEmail_ID", acNormal
        [Forms]![F_FranchiseeEmail_ID]![ID] = ENNum
        
        'Open Franchisee Report & Save
        DoCmd.OpenReport "R_FranchiseeEmail_Fees", acViewPreview
        DoCmd.OutputTo acOutputReport, "", acFormatHTML, Mypath & Myfilename, True
        DoCmd.Close acReport, "R_FranchiseeEmail_Fees"
        DoCmd.Close acForm, "F_FranchiseeEmail_ID"
        
        'Send Report Via Email
        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    ' CDO Source Defaults
         Set Flds = iConf.Fields
            With Flds
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                           = "Ccdenexch01"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                .Update
            End With

        strbody = "Dear " & Contact & "," & vbNewLine & vbNewLine & _
        "Please find attached your Weekly Franchisee Fee Report for the week ending Sunday " & WkEnd & _
        ". Weekly Fees will be electronically transferred from the accounts referenced on the attached report." _
        & vbNewLine & vbNewLine & "Please contact Tiana Hood at 303.633.1504 or via email at thood@smashburger.com if you have any questions." _
        & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & vbNewLine & "Smashburger Accounting"
        
        
        
        

        
        With iMsg
            Set .Configuration = iConf
            .To = Email
            .CC = """Smashburger Accounting"" <accounting@smashburger.com>"
            .BCC = ""
            .From = """Smashburger Accounting"" <accounting@smashburger.com>"
            .Subject = MySubject
            .TextBody = strbody
            .AddAttachment Mypath & Myfilename
            .Send
        End With
    
        
        
        
      
      
      
      
      
      
 

      RS.MoveNext
      Loop
      
      DoCmd.Close acTable, "T_FranchiseEmail_TempTable1"
    
    End If
    RS.Close











End Sub

Open in new window

Error.doc
Tbyrd777Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

FlysterCommented:
In your AcctContactEmail field, reference the line:
Email = RS.Fields("AcctContactEmail"), do you have the address  thood@smashburger.com or Tianahood@me.com? 500 5.7.1 is an invalid address. The numbers can go no higher than 255.

Flyster
   
Tbyrd777Author Commented:
I have Tianahood@me.com in the "AcctContactEmail" field.  thood@smashburger.com is my work email for which this code works fine.  The only problem happens when I try to send to a non-smashburger.com email address.
Dale FyeOwner, Developing Solutions LLCCommented:
Have you tried using the SendObject method?  It would work pretty much the same as this,  but you would not have to use the Output to method to save the report first.

The way I would do this is similar to:

1.  Open the report
2.  Create your recordset (for the Do Loop)
3.  Create your loop

3.a  Inside the loop, set the Filter property of the report to something like:

     Reports("ReportName").Filter = "[ID] = " & ENNum
     Reports("ReportName").FilterOn = True

3.b  Create the message body
3.c   use the docmd.sendobject method  to send the email
3.d  Move to the next record
3.e Close the loop
4.  Close the recordset
5.  Close the report

HTH
Tbyrd777Author Commented:
I checked with our IT department and it turns out the problem was due to security at the server level.  Instead I set up email addresses for each group of recipiant that our company email addresses linked to the email addresses for the recipiants and it worked like a charm.

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
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
Microsoft Access

From novice to tech pro — start learning today.