Page 2 of 2 FirstFirst 12
Results 16 to 20 of 20
  1. #16
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    Can't find it.
    What I have that is different is how I approached the construct of the html part. I'll post the general idea that you may or may not want to incorporate somehow into June7's looping. I built the header separately and used header tags, not cell (td) tags:
    Code:
    strHeader = "<table><tr><th>Supplier Ref</th><th>Invoice No</th><th>Invoice Date</th><th>Gross</th>"
    strHeader = strHeader & "<th>VAT</th><th>WHT</th><th>LCD</th><th>Payment</th><th>Curr</th><th>Date Received</th>"
    strHeader = strHeader & "<th>Pay</th><th>Status</th><th>Payment Date</th><th>Payment Ref</th></tr>"
    and added the header to an email body variable (which at first is "" by default)
    Code:
    emlBody = strHeader & "<tr>" & conCatFields(rs) & "</tr>"
    'this starts the row with the row tag, adds each field & closes the row tag
    and used a function to build the table row for each recipient record (my recordset was also named rs, so you have to use the correct name, which will be whatever you name the one used for building the rows for any specific recipient)
    Code:
    Private Function conCatFields(rs As Recordset) As String
    Dim i As Integer
    
    i = 0
    For Each fld In rs.Fields
       conCatFields = conCatFields & "<td>" & rs.Fields(i) & "</td>"
       i = i + 1
       Next
    End Function
    after the inner loop completes but before the record moves to the next recipient of the DISTINCT recordset, you'd add the closing table tag to the email variable:
    Code:
    emlBody = emlBody & "</table>"
    and send the email before moving on to the next recipient and repeating.


    What may not be to your liking with the function is the absence of formatting. That you can probably add to suit.
    Hope some of that helps.
    Last edited by Micron; 09-05-2017 at 07:36 PM. Reason: added info
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  2. #17
    oladapo is offline Novice
    Windows 7 64bit Access 2013 64bit
    Join Date
    Aug 2017
    Posts
    10
    Hello June7/Micron,


    Thank you for your assistance, I have tried the code but it returned "Runtime Error: 3021 No current record" just immediately after the Loop to the end of the "</body></html>". Please see my code below.


    Code:
     Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim rsSupp As DAO.Recordset
        Dim rsFile As DAO.Recordset
        Set db = CurrentDb
        Dim olApp As Outlook.Application
        Dim objMail As Outlook.MailItem
        Set olApp = Outlook.Application
        Dim FileName As String
        Dim FilePath As String
        Dim Email As String
        Dim YTD As String
          
        
        Set rsSupp = db.OpenRecordset("SELECT DISTINCT SupplierRef, Email1 FROM tbl_PayNGNArchieve WHERE PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'")
        Set rs = db.OpenRecordset("SELECT * FROM tbl_PayNGNArchieve WHERE SupplierRef = '" & rsSupp!SupplierRef & "' AND PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'")
        
        Do Until rsSupp.EOF
        Set objMail = olApp.CreateItem(olMailItem)
        With objMail
        .To = rsSupp!Email1
        .subject = "Payment Advice - " & rs!SupplierRef
        .Importance = olImportanceHigh
        'Set body format to HTML
        .bodyFormat = olFormatHTML
        .bodyFormat = olFormatHTML
           
           Do Until rs.EOF
            On Error Resume Next 'Keep going if there is an error
            .HTMLBody = .HTMLBody & "<tr>" _
                & "<td>" & rs!PaymentRef & "</td>" _
                & "<td>" & rs!InvoiceNo & "</td>" _
                & "<td>" & rs!InvoiceDate & "</td>" _
                & "<td>" & Format(Trim(rs!Gross), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!VAT), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!WHT), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!LCD), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!Payment), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & rs!Curr & "</td>" _
                & "</tr>"
            rs.MoveNext
        Loop
        .HTMLBody = "<font face=Calibri><h3>Dear " & rs!SupplierRef & ",</h3> " _  ''---Failure occurs here
            & "Please be informed of the payment of " & rs!Curr & Format(Trim(rs!Payment), "#,##0.00;(#,##0.00)") & " made into your company’s bank account.<b> " _
            & "<p><b>Find below, breakdown of invoice(s) for which payment was made and please acknowledge receipt of funds upon confirmation.</b><br />" _
            & "<html><head><style>" _
            & "table,th,td{border: 1px solid black; border-collapse: collapse;}table,th,td{padding: 5px;}th{text-align: left;}</style></head>" _
            & "<body><table>" _
            & "<tr><th>Payment Reference</th>" _
            & "<th>Invoice Number</th>" _
            & "<th>Invoice Date</th>" _
            & "<th>Gross Amountz</th>" _
            & "<th>VAT</th>" _
            & "<th>WHT</th>" _
            & "<th>LCD</th>" _
            & "<th>Net Amount</th>" _
            & "<th>Currency Code</th></tr>" _
            & .HTMLBody _
            & "</table>" _
            & "<br><br>Regards " _
            & "<br>Olajumoke Nwabuisi." _
            & "</body></html>"    ''---Failure ends here
        rs.Close
        
        FileName = rsSupp!SupplierRef
        FilePath = "C:\Users\Test\Client\" & FileName & " " & Format(Now(), "dd_mm_yyyy_hh_mm_ss") & ".pdf"
        
        'DoCmd.OpenReport "VendorYTD", , "SupplierRef = " & rsSupp!SupplierRef & " AND PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'"
        DoCmd.OutputTo acOutputReport, "VendorYTD", acFormatPDF, FilePath
        DoCmd.Close acReport, "VendorYTD"
        .Attachments.Add FilePath
        .display
        Kill FilePath
        End With
        rsSupp.MoveNext
    Loop
    rsSupp.Close
            MsgBox ("Emails successfully sent"), vbInformation, Title
    End Function
    I checked the table for records, records exists. I hardcoded the Supplier codes and it looped for the number of transactions for each Supplier, which shows that the first loop works fine but the errors shows up at .HTMLBody = "<font face=Calibri><h3>Dear " & rs!SupplierRef & ",</h3> "

    I am now running on Ms Windows 10 32bit Access 2013.

  3. #18
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    Not my code but I'll take a guess for you.

    Do Until rs.EOF - this states do stuff until we reach the end of file; where there is no record
    stuff in here, then
    Loop - this causes the steps to repeat until the EOF is reached

    rs!SupplierRef - this is referring to a field in a record set for which there is no longer a record (EOF mentioned above)

    Suggest you create a variable for SupplierRef and use it throughout instead of rs!SupplierRef, and make sure it is updated each time the outer loop goes to a new record with a new SupplierRef value.
    Or wait until June7 has a chance to reply.

  4. #19
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    There is typo in my suggested code:

    .Subject = "Payment Advice - " & rs!SupplierRef

    should be

    .Subject = "Payment Advice - " & rsSupp!SupplierRef

    Then you repeat this error in:

    .HTMLBody = "<font face=Calibri><h3>Dear " & rs!SupplierRef & ",</h3> "

    The Set rs line needs to be moved into the first loop. See my suggested code.

    Why have you commented the OpenReport line?
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  5. #20
    oladapo is offline Novice
    Windows 7 64bit Access 2013 64bit
    Join Date
    Aug 2017
    Posts
    10
    Hello June7/Micron

    Thank you so far, the mail and attachment working now as expected leaving out the "Kill Filepath". I want the files deleted after sending.

    Code:
    Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim rsSupp As DAO.Recordset
        Set db = CurrentDb
        Dim olApp As Outlook.Application
        Dim objMail As Outlook.MailItem
        Set olApp = Outlook.Application
        Dim FileName As String
        Dim FilePath As String
        Dim Email As String
        Dim YTD As String
        Dim Totalpay As String
        Dim Msg As String
       
           
        Set rsSupp = db.OpenRecordset("SELECT DISTINCT SupplierRef, Email1 FROM tbl_PayNGNArchieve WHERE PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'")
        'Totalpay = DSum("Payment", "tbl_PayNGNArchieve", "[PaymentRef]= '" & Forms![SendNGN]!txt_PayRef & "'  AND [SupplierRef] = '" & rsSupp!SupplierRef & "'  ")
        Msg = DCount("SupplierRef", "tbl_PayNGNArchieve", "[PaymentRef]='" & Forms![SendNGN]!txt_PayRef & "' AND [Pay]='Yes' ")
        'Set rs = db.OpenRecordset("SELECT * FROM tbl_PayNGNArchieve WHERE SupplierRef = '" & rsSupp!SupplierRef & "' AND PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'")
        
        Do Until rsSupp.EOF
        Set objMail = olApp.CreateItem(olMailItem)
        With objMail
        .To = rsSupp!Email1
        .subject = "Payment Advice - " & rsSupp!SupplierRef
        .Importance = olImportanceHigh
        'Set body format to HTML
        .bodyFormat = olFormatHTML
        .bodyFormat = olFormatHTML
        
        Set rs = db.OpenRecordset("SELECT * FROM tbl_PayNGNArchieve WHERE SupplierRef = '" & rsSupp!SupplierRef & "' AND PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'")
           Do Until rs.EOF
            On Error Resume Next 'Keep going if there is an error
            
            
            .HTMLBody = .HTMLBody & "<tr>" _
                & "<td>" & rs!PaymentRef & "</td>" _
                & "<td>" & rs!InvoiceNo & "</td>" _
                & "<td>" & rs!InvoiceDate & "</td>" _
                & "<td>" & Format(Trim(rs!Gross), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!VAT), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!WHT), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!LCD), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & Format(Trim(rs!Payment), "#,##0.00;(#,##0.00)") & "</td>" _
                & "<td>" & rs!Curr & "</td>" _
                & "</tr>"
            rs.MoveNext
        Loop
        .HTMLBody = "<font face=Calibri><h3>Dear " & rsSupp!SupplierRef & ",</h3> " _
            & "Please be informed of the payment made into your company’s bank account.<b> " _
            & "<p><b>Find below, breakdown of invoice(s) for which payment was made and please acknowledge receipt of funds upon confirmation.</b><br />" _
            & "<html><head><style>" _
            & "table,th,td{border: 1px solid black; border-collapse: collapse;}table,th,td{padding: 5px;}th{text-align: left;}</style></head>" _
            & "<body><table>" _
            & "<tr><th>Payment Reference</th>" _
            & "<th>Invoice Number</th>" _
            & "<th>Invoice Date</th>" _
            & "<th>Gross Amountz</th>" _
            & "<th>VAT</th>" _
            & "<th>WHT</th>" _
            & "<th>LCD</th>" _
            & "<th>Net Amount</th>" _
            & "<th>Currency Code</th></tr>" _
            & .HTMLBody _
            & "</table>" _
            & "<br><b>Regards " _
            & "<br>Olajumoke Nwabuisi." _
            & "</body></html>"
        rs.Close
       
        FileName = rsSupp!SupplierRef
        FilePath = "C:\EmailReports\" & FileName & " " & Format(Now(), "dd_mm_yyyy_hh_mm_ss") & ".pdf"
        
        DoCmd.OpenReport "Test", acViewPreview, , "SupplierRef = '" & rsSupp!SupplierRef & "'  AND PaymentRef='" & Forms![SendNGN]!txt_PayRef & "'"
        DoCmd.OutputTo acOutputReport, "Test", acFormatPDF, FilePath
        DoCmd.Close acReport, "Test"
        Debug.Print FileName, FilePath
        .Attachments.Add FilePath
        .display
        
        End With
        rsSupp.MoveNext
    Loop
    
    
    rsSupp.Close
    
    
    Set rs = Nothing
    Set db = Nothing
    
    
    Kill FilePath
        
    
    
            Msgbox ("Emails successfully sent"), vbInformation, Title
    End Function
    THANK YOU JUNE7/MICRON!!!!

Page 2 of 2 FirstFirst 12
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 4
    Last Post: 08-12-2015, 12:52 PM
  2. Sending Outlook Emails from form in Access 2007
    By IncidentalProgrammer in forum Programming
    Replies: 4
    Last Post: 01-09-2015, 11:06 AM
  3. Sending Emails from Access via Outlook
    By Terry Lawson in forum Programming
    Replies: 3
    Last Post: 11-14-2014, 10:03 AM
  4. Sending HTML files via Access to Outlook
    By Yann63 in forum Programming
    Replies: 4
    Last Post: 02-13-2014, 05:34 PM
  5. Access 97 Sending a Report to Outlook with Problems
    By PianistChris in forum Access
    Replies: 3
    Last Post: 07-18-2013, 12:17 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums