通过电子邮件以 HTML 格式发送 Access 报告

Question

我有一个 MS Access 报告，其中包含来自一个表（包括电子邮件地址）的客户记录以及通过查询获取的其他表中的链接分组记录。

我想在电子邮件正文中将报告的内容分别发送给每个客户（而不是作为附件），我可以将文本放入电子邮件正文中，但没有格式，也没有标题中的图片。

我使用了以下代码，它在单击按钮后运行。如果有人可以帮助解决格式问题，并且如果有一种方法可以自动为我的 200 多个客户发送电子邮件，而无需每次都单击按钮（例如循环或其他东西），我将不胜感激：

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

由于 MS Access 报告是专门的富文本格式，因此不容易转换为 HTML。您需要使用 HTML 标记重建您的报告。但是，还有另一种方法。

考虑创建一个Outlook email template (.oft)，其中包含所有需要的图像、颜色、字体和其他格式，并带有%...% 标记等占位符：

尊敬的 %ClientName%：

感谢您在 %salesdate% 以 %totalsales% 购买 %product%。我们感谢您 %years% 年的业务。

%销售表%

最好的祝愿，
我的公司管理

然后，让 MS Access 循环通过电子邮件详细信息的记录集和消息正文的文本来填充占位符。处理 SQL 或 VBA 中的任何日期/当前/百分比格式。因为您需要一个组级别的多记录摘要，所以在 1) 客户级别和 2) 销售级别运行两个循环。

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