将动态表插入电子邮件

Question

以下脚本生成文本列表并将其插入电子邮件并发送给特定人员。它作为纯文本工作正常。我想要完成的是创建一个动态的html表并插入到电子邮件的正文中。我试图在TextBody周围为.HTMLBody属性添加html标签，但没有发送电子邮件。我将模板文件更改为.html文件并在那里创建了html表，但电子邮件的代码为纯文本。

以下是工作输出的示例：

AREA: Line 2
SPID: 308582   Name: LINE 2 ROBERTS NO 2 COOLING LINE East
Expectation: BiMonthly
Projected: +2mos   Last Sampled Approved Date: 2013-06-10

我想将冒号之前的所有文本都作为标题，然后将结果列在标题下方。

Option Explicit

Dim mConnectionString, objFSO, vEmailTemplateFile, vEmailTemplateSPID
Dim blnDebugMode, DebugLogLevel
Dim oConn 'ADO connection
Dim vLogDir,LogFilePrefix,gstrmsg
Dim adminEmail, EmailSubject, smtpServer

mConnectionString = "Provider=SQLOLEDB;Server=;Initial Catalog;Integrated Security=;"


vEmailTemplateFile = "C:\EMAILScripts\SampleReminderTemplate.txt"
vEmailTemplateSPID = "C:\EMAILScripts\SampleReminderSPIDTemplate.txt"



            'Read in SPID template 
            sSPIDTemplate = ""
            Set objFileStreamIn = objFSO.OpenTextFile(vEmailTemplateSPID, ForReading)
            Do Until objFileStreamIn.AtEndOfStream
                sSPIDTemplate = sSPIDTemplate & objFileStreamIn.ReadLine & vbCrLf
            Loop
            objFileStreamIn.Close



            'Read in email template and create email by replacing tokens and then send
            sEmailMsg = ""
            Set objFileStreamIn = objFSO.OpenTextFile(vEmailTemplateFile, ForReading)
            Do Until objFileStreamIn.AtEndOfStream
                sEmailMsg = sEmailMsg & objFileStreamIn.ReadLine & vbCrLf
            Loop
            objFileStreamIn.Close

            sEmailMsg = Replace(sEmailMsg,"{name}",sName)
            sEmailMsg = Replace(sEmailMsg,"{body}",sBody)
            'LogMessage "sEmailMsg: " & sEmailMsg, False, LogDebug

            If blnDebugMode Then
                sEmail = adminEmail '<< In debug mode send ALL emails to the admin address set above
            End If

If blnEmail Then
        If SendMailByCDO(adminEmail, EmailSubject, FullErrorMsg, "", "", smtpServer, adminEmail) <> 0 Then
            LogMessage "Could Not send email: " & ErrMsg, False, LogError
            If errNumber <> Err.Number Then
                Err.Clear
            End If
        End If
    End If


'***************************************
'* Sends an email To aTo email address, with Subject And TextBody.
'* The email is In text format.
'* Lets you specify BCC adresses, Attachments, smtp server And Sender email address
'***************************************
Function SendMailByCDO(aTo, Subject, TextBody, BCC, Files, smtp, aFrom )
  'On Error Resume Next

  Dim Message 'As New CDO.Message '(New - For VBA)

  Set Message = CreateObject("CDO.Message")


  With Message.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = aFrom

    'SMTP settings - without authentication, using standard port 25 on host smtp
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtp

    'SMTP Authentication
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous

    '**** You can also specify authentication properties for the smtp session using
    '**** smtpauthenticate and sendusername + sendpassword: 
    '* .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
    '* .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "info@mycompany.to"
    '* .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
    '* .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True/False
    '****

    .Update
  End With

  'Set other message fields.
  With Message
    .From = aFrom
    .To = aTo
    .Subject = Subject

    'Set TextBody property If you want To send the email As plain text
    '.TextBody = TextBody 

    '* Set HTMLBody  property If you want To send the email As an HTML formatted
    .HTMLBody = TextBody 

    'Blind copy And attachments are optional.
    If Len(BCC)>0 Then .BCC = BCC
    If Len(Files)>0 Then .AddAttachment Files

    'Send the email
    .Send
  End With

    IF blnDebugMode and Err.Number <> 0 then
        Wscript.Echo "SendMailByCDO err: " &  err.description
    End IF

  'Returns zero If successful. Error code otherwise 
  SendMailByCDO = Err.Number
End Function

EDIT1：删除了仅显示电子邮件功能的额外代码。

我创建了一个名为SampleReminderSPIDTemplateTable.html的html文件来替换SampleReminderSPIDTemplate.txt，该文件中包含以下内容：

<html xmlns="http://www.w3.org/1999/xhtml">
  <table style="width:100%">
  <tr>
    <td>{AREANAME}</td>
    <td>{SPID}</td>     
    <td>{SPIDNAME}</td>
    <td>{LASTSAMPLEAPPROVEDDATE}</td>
    <td>{EXPECTATION}</td>      
    <td>{PROJECTED}</td>
  </tr> 
</table>
</html>

我也尝试使用.HTMLBody属性，但没有发送电子邮件。

.HTMLBody = "<html><body><pre>" & TextBody & "</pre></body></html>"