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?
 
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.
0
 
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
   
0
 
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.
0
 
Dale FyeCommented:
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
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.