我正在使用VBA格式化一个电子邮件，该电子邮件将根据t1stNoticeEmails表中CheckReturnReason列中的值创建不同的文本。
我正在尝试对其进行格式化，以便如果特定原因仅在表格中列出一次，则电子邮件的格式为特定方式，其中显示了一个表格，如果列出的原因不止一次，则会附加电子表格有了这些信息。这是代码当前的外观，不包括针对多个条目的Excel附件的任何内容。
如果rst2.RecordCount> 1，我将如何包含不同的格式？
Sub FirstEmail_DuplicatePayment_ReviewVBA()
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
Dim CheckNum As String
Dim NameOfRecipient As String
Dim StrSQL1 As String
Dim NameSpaceOutlook As Outlook.Namespace
Dim sAddressText As String
Dim sAddress1 As Variant
Dim sAddress2 As Variant
Dim sAddressCity As Variant
Dim sAddressState As Variant
Dim sAddressZip As Variant
gPARAttachment = "S:\UPAY\Z_NewStructure\..."
'SEND FIRST NOTICE EMAILS'
'------------------'
Set rst2 = CurrentDb.OpenRecordset("select distinct ContactEmails from t1stNoticeEmails WHERE CheckReturnReason = 'DuplicatePayment'")
If rst2.RecordCount = 0 Then 'checks if recordset returns any records and continues if records found and exits if no records found
Exit Sub
End If
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='Calibri'><b>" & _
"<tr bgcolor=#4DB84D>" & _
td("CheckNumber") & _
td("PayeeName") & _
td("VendorID") & _
td("DocNo / ERNo / PONo") & _
td("Amount") & _
td("CheckDate") & _
"</tr></b></font>"
strFntNormal = "<font color=black face='Calibri' size=3>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM t1stNoticeEmails where ContactEmails='" & rst2!ContactEmails & "' AND CheckReturnReason = 'DuplicatePayment' " _
& "Order by FullName asc")
If rst.RecordCount = 0 Then
rst2.Close
Set rst2 = Nothing
Exit Sub
End If
sAddress1 = rst!OriginalCheckAddress1
sAddress2 = rst!OriginalCheckAddress2
sAddressCity = rst!OriginalCheckCity
sAddressState = rst!OriginalCheckState
sAddressZip = rst!OriginalCheckZip
sAddressText = "<Font face='Calibri'>" _
& "The following check(s) sent to " _
& sAddress1 & " " & sAddress2 & " " & sAddressCity & " " & sAddressState & " " & sAddressZip _
& " have been returned to the University by the payee. <br><br>"
rst.MoveFirst
NameOfRecipient = rst!FullName
CheckNum = rst!CheckNumber
'Build HTML Output for the DataSet
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = _
strTableBody & _
"<tr>" & _
"<TD nowrap>" & rst!CheckNumber & "</TD>" & _
"<TD nowrap>" & rst!FullName & "</TD>" & _
"<TD nowrap>" & rst![VendorID/UIN] & "</TD>" & _
"<TD nowrap>" & rst![DocNo / ERNo / PONo] & "</TD>" & _
"<TD align='right' nowrap>" & Format(rst!AmountDue, "currency") & "</TD>" & _
"<TD nowrap>" & rst!OriginalCheckDate & "</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 CaptureDPBodyText
With objMail
'Set body format to HTML
.To = rst2!ContactEmails
.BCC = gDPEmailBCC
.Subject = gDPEmailSubject & " - Check# " & CheckNum & " - " & NameOfRecipient
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody
.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & sAddressText & strTableBody & " </BODY></HTML>"
.HTMLBody = .HTMLBody & gDPBodySig
.SentOnBehalfOfName = "..."
.Attachments.Add gPARAttachment
.Display
'.Send
End With
rst2.MoveNext
'Loop
rst.Close
Set rst = Nothing
rst2.Close
Set rst2 = Nothing
End Sub`
我发现RecordCount对Access不可靠。我使用像rst.BOF=true AND rst.EOF=true这样的东西来检查没有返回的记录。
要查看是否返回了多条记录，请使用
rst.MoveNext
if rst.EOF=false then <more than one record>
之后
rst.MoveFirst
基本上检查在第一条记录之后读取是否到达数据的末尾。