如何将生成的 HTML 表格转换为 Excel 表格以发送电子邮件？答案

【问题标题】：How to convert a generated HTML table to an Excel sheet for emailing?如何将生成的 HTML 表格转换为 Excel 表格以发送电子邮件？
【发布时间】：2018-12-07 21:53:08
【问题描述】：

我继承了一个带有 VBA 模块的数据库，该模块将数据表插入到 Outlook 电子邮件中。我想更改它，以便将相同数据的 Excel 工作表附加到电子邮件中，而不是在电子邮件正文中插入表格。我不确定如何更改代码来做到这一点。

有人可以帮忙更新一下吗？

代码如下：

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 tDCMEmailList")
    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'>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
    '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 = "xxxx"
        .Display
        '.Send
    End With

    rst2.MoveNext

'Loop

Clean_Up:
    rst.Close
    rst2.Close

    Set rst = Nothing
    Set rst2 = Nothing
    'Set dbs = Nothing


End Sub

【问题讨论】：

这是在邮件中插入一个 HTML 表格，收件人可以轻松地将其复制并粘贴到 Excel 中。这真的很不错。尽管要移至 Excel 附件，但需要完全替换此代码。您必须 1. 将表格导出到 Excel 2. 将导出的文件附加到您正在构建的电子邮件中。反而。 Like this 但将其更改为 excel 输出而不是 pdf
那么这个数据表是VBA在运行时为电子邮件生成的？它还不能作为工作表在任何地方使用？

标签： excel vba ms-access outlook

【解决方案1】：

由于您似乎不想使用代码的表格编辑部分，这可能满足您的需求。

在您的 With objMail 部分中，这样的事情会起作用（更改来源和文件名）：

sOrigin = "C:\Users\Desktop\"
sFilename = "MyExcelSheet.xlsx"
.Attachments.Add (sOrigin & sFilename)

不清楚您的具体需求是什么，但这足以作为将 Excel 工作表附加到电子邮件的一般方法。

注意：我强烈建议删除与创建输出表相关的代码部分，以实现您最终期望的目标。

【讨论】：

【解决方案2】：

因此，将结果作为附件发送实际上比在电子邮件中作为表格发送要容易得多，只要您保存了包含您需要发送的数据的查询。

基本上，您可以使用Docmd.SendObject 函数发送已保存的查询。但是，如前所述，它无法指定 SendOnBehalfOf 属性。看看下面的代码：

Sub DCMEmailReviewVBA()
    ' assuming you have a saved query called qData
    ' that contains SQL like the following:
    '   select SELECT * 
    '   FROM tEmailData 
    '   where DCM_email=(select top 1 DCM_Email from tDCMEmailList)
    '   order by Cardholder, Card_Type asc

    Dim strTO as string

    ' there are better ways to do this, but this will quickly 
    ' get us what we want
    strTO = Dlookup("DCM_Email", "tDCMEmailList")

    ' the only thing this doesn't handle is the SendOnBehalfOfName
    ' if this is necessary to your process, you might want to stick with @Jiggles32
    docmd.SendObject _
            objecttype:=acSendQuery, _
            objectname:="qData", _
            outputformat:=acFormatXLSX , _
            to:=strTO, _
            cc:="", _
            bcc:=gDCMEmailBCC, _
            subject:=gDCMEmailSubject, _
            messagetext:="anything you want to put in your email message", _
            editmessage:=true
End Sub

【讨论】：