我试图将两个数据表放入电子邮件中。
我有VBA代码包含一个表。第二个表的数据位于tEmailData中，该表与DCM_Email字段上的tDistinct_DCMs表相关。
我已经为电子邮件提供了当前的VBA，并为第二个表提供了VBA格式。
如何在第一个表和一段短文本后添加该表？
Option Compare Database
Option Explicit
Public Sub DCMEmailReviewVBA()
Dim rst As DAO.Recordset
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim rst2 As DAO.Recordset
Dim strTableBeg As String
Dim strTableBody As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strTableHeader As String
Dim strFntEnd As String
Set rst2 = CurrentDb.OpenRecordset("select distinct DCM_email from tDistinct_DCMs")
rst2.MoveFirst
'Create e-mail item
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Do Until rst2.EOF
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Define format for output
strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
strTableEnd = "</table>"
strTableHeader = "<font size=3 face=" & Chr(34) & "Calibri" & Chr(34) & "><b>" & _
"<tr bgcolor=lightBlue>" & _
"<TD align = 'left'>Status</TD>" & _
"<TD align = 'left'>First Name</TD>" & _
"<TD align = 'left'>Last Name</TD>" & _
"<TD align = 'left'>UIN</TD>" & _
"</tr></b></font>"
strFntNormal = "<font color=black face=" & Chr(34) & "Calibri" & Chr(34) & " size=3>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM tFinalDCM_EmailList where DCM_Email='" & rst2!DCM_Email & "' Order by [Cardholder_UIN] asc")
rst.MoveFirst
'Build HTML Output for the DataSet
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = strTableBody & _
"<tr>" & _
"<TD align = 'left'>" & rst![Action] & "</TD>" & _
"<TD align = 'left'>" & rst![Cardholder First Name] & "</TD>" & _
"<TD align = 'left'>" & rst![Cardholder Last Name] & "</TD>" & _
"<TD align = 'left'>" & rst![Cardholder_UIN] & "</TD>" & _
"</tr>"
rst.MoveNext
Loop
'rst.MoveFirst
strTableBody = strTableBody & strFntEnd & strTableEnd
'rst.Close
'Set rst2 = CurrentDb.OpenRecordset("select distinct ch_email from t_TCard_CH_Email")
'rst2.MoveFirst
Call CaptureDCMBodyText
With objMail
'Set body format to HTML
.To = rst2!DCM_Email
.BCC = gDCMEmailBCC
.Subject = gDCMEmailSubject
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & gDCMBodyText
.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"
.HTMLBody = .HTMLBody & gDCMBodySig
.SentOnBehalfOfName = "..."
.Display
'.Send
End With
rst2.MoveNext
'Loop
Clean_Up:
rst.Close
rst2.Close
Set rst = Nothing
Set rst2 = Nothing
'Set dbs = Nothing
End Sub
Function td(strIn As String) As String
td = "<TD nowrap>" & strIn & "</TD>"
End Function
VBA用于所需的第二个表：
strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
strTableEnd = "</table>"
strTableHeader = "<font size=3 face=" & Chr(34) & "Calibri" & Chr(34) & "><b>" & _
"<tr bgcolor=lightblue>" & _
"<TD align = 'left'>Card Type</TD>" & _
"<TD align = 'left'>Cardholder</TD>" & _
"<TD align = 'left'>ER or Doc No</TD>" & _
"<TD align = 'center'>Trans Date</TD>" & _
"<TD align = 'left'>Vendor</TD>" & _
"<TD align = 'right'>Trans Amt</TD>" & _
"<TD align = 'left'>TEM Activity Name or P-Card Log No</TD>" & _
"<TD align = 'left'>Status</TD>" & _
"<TD align = 'right'>Aging</TD>" & _
"</tr></b></font>"
strFntNormal = "<font color=black face=" & Chr(34) & "Calibri" & Chr(34) & " size=3>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM tEmailData where DCM_email='" & rst2!DCM_Email & "' Order by Cardholder, Card_Type asc")
rst.MoveFirst
'Build HTML Output for the DataSet
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = strTableBody & _
"<tr>" & _
"<TD align = 'left'>" & rst!Card_Type & "</TD>" & _
"<TD align = 'left'>" & rst!Cardholder & "</TD>" & _
"<TD align = 'left'>" & rst!ERNumber_DocNumber & "</TD>" & _
"<TD align = 'center'>" & rst!Trans_Date & "</TD>" & _
"<TD align = 'left'>" & rst!Vendor & "</TD>" & _
"<TD align = 'right'>" & Format(rst!Trans_Amt, "currency") & "</TD>" & _
"<TD align = 'left'>" & rst!ACTIVITY_Log_No & "</TD>" & _
"<TD align = 'left'>" & rst!Status & "</TD>" & _
"<TD align = 'right'>" & rst!Aging & "</TD>" & _
"</tr>"
rst.MoveNext
Loop
我还没看过你的表，但构建Html文档的代码有问题。
.HTMLBody = .HTMLBody & gDCMBodyText
.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"
.HTMLBody = .HTMLBody & gDCMBodySig
我找不到gDCMBodyText，之前的声明没有在HtmlBody中放置任何内容，那你为什么要连接它呢？
<HTML>必须先到，</HTML>必须到最后。
你在提问中提到你想要包含文字，但我不知道在哪里。
我建议如下：
Dim Table1 As string ' First table: <table> ... </table>
Dim Table2 As string ' Second table: <table> ... </table>
Dim TextPre As string ' Text to come before first table
Dim TextMid As string ' Text to come between tables
Dim TextPost As string ' Text to come after second table
然后为上面的字符串分配适当的值
.HtmlBody = "<html><body>" & vbLf & _
TextPre & vbLf & _
Table1 & vbLf & _
TextMid & vbLf & _
TextPost & vbLf & _
"</body></html>"
第2部分
我将此视为四个不同的问题：（1）格式表1正确，（2）格式表2正确，（3）正确组合表和（4）创建HtmlBody。
对于诸如1,2和3之类的问题，我使用下面的例程。宏HtmlDoc将Head和Body元素组合成一个简单的Html文档。这没什么大不了的，但确实让生活变得更简单。宏PutTextFileUtf8输出一个字符串作为UTF-8文件。注1：UTF-8是Html文件的默认编码，允许文件中的任何Unicode字符。注意2：此宏需要引用“Microsoft ActiveX Data Objects n.n Library”。
我将使用这些例程来（1）检查表1是否正确创建，（2）检查表2是否正确创建和（3）检查表是否正确组合。如果任何文件不是我想要的，我可以查看文本文件。查看格式错误的电子邮件的Html正文更加困难。
Function HtmlDoc(ByVal Head As String, ByVal Body As String)
' Returns a simple Hhml document created from Head and Body
HtmlDoc = "<!DOCTYPE html>" & vbLf & "<html>" & vbLf
If Head <> "" Then
HtmlDoc = HtmlDoc & "<head>" & vbLf & Head & vbLf & "</head>" & vbLf
End If
HtmlDoc = HtmlDoc & "<body>" & vbLf & Body & vbLf & "</body>" & vbLf
HtmlDoc = HtmlDoc & "</html>"
End Function
Public Sub PutTextFileUtf8(ByVal PathFileName As String, ByVal FileBody As String)
' Outputs FileBody as a text file (UTF-8 encoding without leading BOM)
' named PathFileName
' Needs reference to "Microsoft ActiveX Data Objects n.n Library"
' Addition to original code says version 2.5. Tested with version 6.1.
' 1Nov16 Copied from http://stackoverflow.com/a/4461250/973283
' but replaced literals with parameters.
' 15Aug17 Discovered routine was adding an LF to the end of the file.
' Added code to discard that LF.
' References: http://stackoverflow.com/a/4461250/973283
' https://www.w3schools.com/asp/ado_ref_stream.asp
Dim BinaryStream As Object
Dim UTFStream As Object
Set UTFStream = CreateObject("adodb.stream")
UTFStream.Type = adTypeText
UTFStream.Mode = adModeReadWrite
UTFStream.Charset = "UTF-8"
' The LineSeparator will be added to the end of FileBody. It is possible
' to select a different value for LineSeparator but I can find nothing to
' suggest it is possible to not add anything to the end of FileBody
UTFStream.LineSeparator = adLF
UTFStream.Open
UTFStream.WriteText FileBody, adWriteLine
UTFStream.Position = 3 'skip BOM
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open
UTFStream.CopyTo BinaryStream
' Originally I planned to use "CopyTo Dest, NumChars" to not copy the last
' byte. However, NumChars is described as an integer whereas Position is
' described as Long. I was concerned that by "integer" they mean 16 bits.
BinaryStream.Position = BinaryStream.Position - 1
BinaryStream.SetEOS
UTFStream.Flush
UTFStream.Close
Set UTFStream = Nothing
BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
BinaryStream.Flush
BinaryStream.Close
Set BinaryStream = Nothing
End Sub
第3部分
在<TD align = 'left'>Card Type</TD>中，align = 'left'是默认值，因此可以省略。
更重要的是，在Html 4中弃用了align属性，我在Html 5中找不到它。建议使用CSS。
我建议你输出一个像这样的HEAD元素：
<head>
<style>
table {border-collapse:collapse;}
td {border-style:solid; border-width:1px; border-color:#BFBFBF;}
tr.bc-lb {background-color:lightblue;}
td.ha-c {text-align:center;}
td.ha-r {text-align:right;}
</style>
<head>
和TR和TD元素是这样的：
<tr class= “bg-lb”>
<td>Card Type</td>
<td class=“ha-c“>Trans Date</td>"
<td class=“ha-r“>Trans Amt</td>"
table {border-collapse:collapse;}指定CSS折叠表模型。仅当您具有单元格边框时，才会显示折叠和单独模型之间的差异。随着坍塌，边界接触但是分开，它们之间存在小的差距。
td {border-style:solid; border-width:1px; border-color:#BFBFBF;}指定每个单元格都有一个坚固的薄边框，颜色为深灰色，我更喜欢黑色。
tr.bc-lb {background-color:lightblue;}允许我通过在TR开始标记中包含class= “bg-lb”with来将行的背景颜色设置为浅蓝色。
我认为其他款式及其用途可以从上述信息中推断出来。
摘要
如果无法访问您的系统，我无法测试您的代码的任何重写版本。我希望我已经给你足够的信息，允许你修改自己的代码。