asked on

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

Flyster

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

Tbyrd777

ASKER

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 Fye

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

ASKER CERTIFIED SOLUTION

Tbyrd777

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial