我有一个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
由于MS Access报告是专门的富文本格式，因此不容易转换为HTML。您需要使用HTML标记重新生成报表。然而，还有另一种方法。
考虑创建一个Outlook电子邮件模板(.oft(，其中包含所有需要的图像、颜色、字体和其他格式，并带有占位符，如%...%标记：
尊敬的%ClientName%：
感谢您在%salesdate%为%totalsales%购买%product%。我们感谢您%年%的业务。
%salestable%
最美好的祝愿，
MyCompany Management
然后，让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:PathToClientEmail.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