Sending Access reports by email as HTML - html

Question

I have an MS Access report that contains records of clients from one table (including the email address) and linked grouped records from other tables fetched by a Query.
I want to send the content of the report to each client separately in the body of the email (not as an attachment), I am able to get the text put in the body of the email but without the formatting and without the picture in the header.
I used the following code which runs behind a click of a button. I would appreciate if anyone can help with the formatting issue AND if there is a way I can automate sending the emails for my 200+ clients without clicking the button each time (like a loop or something):
Private Sub Command70_Click()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim RTFBody
Set appOutlook = CreateObject("Outlook.application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
DoCmd.OutputTo acOutputReport, "report1", acFormatHTML, "Report.htm", , , , acExportQualityScreen
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("Report.htm", ForReading, False, TristateTrue)
RTFBody = f.ReadAll
f.Close
With MailOutlook
.To = Me.Email.Value
.CC = "anwarmirza.ridha#gmail.com"
.Subject = Me.CR_Number & " " & Me.English_Name & " Weekly Report"
.HTMLBody = "Dear Supplier" & Chr$(13) & Chr$(13) & _
RTFBody
.Send
End With
Set MailOutlook = Nothing
Set appOutlook = Nothing
End Sub

Answer 1

Since MS Access reports are specialized rich text formats, conversion to HTML is not easily available. You would need to rebuild your report with HTML markup. However, there is another approach.
Consider creating an Outlook email template (.oft) with all needed images, colors, fonts, and other formatting with placeholders such as %...% markers:
Dear %ClientName%:
Thank you for purchase of %product% for %totalsales% on %salesdate%. We appreciate your business of %years% years.
%salestable%
Best wishes,
MyCompany Management
Then, have MS Access loop through a recordset of email details and text for message body to fill in placeholders. Handle any date/current/percent formatting in SQL or VBA. Because you need a group level multi-record summary, run two loops at 1) client level and 2) sales level.
strSQL = "SELECT ClientID, ClientName, ...email details... FROM myClientsTable"
Set clientRST = CurrentDb.OpenRecordset(strSQL)
Do While Not clientRST.EOF
Set MailOutlook = appOutlook.CreateItemFromTemplate("C:\Path\To\ClientEmail.oft")
strSQL = "SELECT Col1, Col2, Col3 ...sales details..." _
& " FROM mySalesTable" _
& " WHERE ClientID = " & clientRST!ClientID
Set salesRST = CurrentDb.OpenRecordSet(strSQL)
' TABLE COLUMNS
strTable = "<table><th>"
For i = 1 to salesRST.Fields.Count
strTable = strTable & "<td>" & salesRST.Fields(i-0).Name & "</td>"
Next i
strTable = strTable & "</th>"
' TABLE ROWS
salesRST.MoveFirst
While Not salesRst.EOF
strTable = strTable & "<tr>"
For i = 1 to salesRST.Fields.Count
strTable = strTable & "<td>" & salesRST.Fields(i-0).Value & "</td>"
Next i
strTable = strTable & "</tr>"
salesRST.MoveNext
Wend
strTable = strTable & "</table>"
salesRST.Close
With MailOutlook
' DYNAMIC RECIPEINT
.To = clientRST!Email
.CC = "anwarmirza.ridha#gmail.com"
' DYNAMIC SUBJECT
.Subject = clientRST!CR_Number & " " & clientRST!English_Name & " Weekly Report"
' REPLACE PLACEHOLDERS
.HTMLBody = Replace(.HTMLBody, "%ClientName%", clientRST!ClientName)
.HTMLBody = Replace(.HTMLBody, "%product%", clientRST!product)
.HTMLBody = Replace(.HTMLBody, "%totalsales%", clientRST!totalsales)
.HTMLBody = Replace(.HTMLBody, "%salesdate%", clientRST!salesdate)
.HTMLBody = Replace(.HTMLBody, "%years%", clientRST!client_years)
' ADD SALES TABLE
.HTMLBody = Replace(.HTMLBody, "%salestable%", strTable)
.Send
End With
Set MailOutlook = Nothing
clientRST.MoveNext
Loop
clientRST.Close