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!!!!