时间戳

首页 > 解决方案 > 动态生成嵌入在 VBA 电子邮件生成中的 HTML 表

html - 动态生成嵌入在 VBA 电子邮件生成中的 HTML 表

问题描述

我正在尝试创建一封带有正文的电子邮件和一个从给定数据集自动生成的表格。现在，我从包含所有输入的单独工作表中提取数据，然后您只需从下拉列表中选择一个人名，数据就会自动填充。我希望将所需列中的数据提取到电子邮件正文中间的表格中。但是，我不知道如何使表格以 HTML 格式动态化，以便它可以有 2、3、1 行数据，具体取决于显示的内容。

我想要的另一个选项是让 VBA 根据列表中的名称自动查找相似的数据，并根据该名称自动提取数据，但我不知道这是否可能。

我对 VBA 非常了解 - 大约 2 周前才自学了这封电子邮件，所以我不是 100% 熟悉所有选项。但是，我在下拉布局上的循环中遇到的一个问题是，要让信息自动生成，必须将公式粘贴到列中，因此从技术上讲，它们不是空白行。

我还有一条消息，我需要从单独的表格中的单元格中插入，因为我需要能够对其进行 HTML 格式化。同样，我不确定我正在做的任何事情是否是最好的方法，但我想不出更好的方法。

这是我的代码：

Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim olApp As Outlook.Application

Set olApp = CreateObject("Outlook.application")

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    olMail.To = what_address
    olMail.Subject = subject_line
    olMail.BodyFormat = olFormatHTML
    olMail.HTMLBody = mail_body
    olMail.Display
    'olMail.Send
End Sub


Sub SendMassEmail()
row_number = 1

    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim amount As String
    Dim name_two As String
    Dim mail_body_table As String

    mail_body_message = Sheet2.Range("B2")
    full_name = Sheet1.Range("E" & row_number + 1)
    name_2= Sheet1.Range("G" & row_number + 1)
    amount = Format(Sheet1.Range("K" & row_number + 1), "Currency")

    mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
    mail_body_message = Replace(mail_body_message, "nametwo_here", name_two)
    mail_body_message = Replace(mail_body_message, "replace_amount", amount)

    Call SendEmail(Sheet1.Range("F" & row_number + 1), "Test 2018", mail_body_message)

'MsgBox "Email Send Complete"

End Sub

标签： htmlvbaexcel

解决方案

前段时间写过类似的东西。

此函数将返回一个带有 HTML 表格的字符串，该表格包含指定区域内的数据。

Private Function BuildHTMLTable(ByRef wSheet As Worksheet, ByVal StartRow As Long, ByVal StartCol As Long, Optional ByVal EndRow As Long = -1, Optional ByVal EndCol As Long = -1) As String

    If EndRow = -1 Then EndRow = wSheet.UsedRange.Rows.Count + 1
    If EndCol = -1 Then EndCol = wSheet.UsedRange.Columns.Count + 1

    BuildHTMLTable = "<TABLE>"

    Dim iCurRow, iCurCol As Long
    For iCurRow = StartRow To EndRow
        BuildHTMLTable = BuildHTMLTable & "<TR>"

        For iCurCol = StartCol To EndCol
            BuildHTMLTable = BuildHTMLTable & "<TD>" & wSheet.Cells(iCurRow, iCurCol) & "</TD>"
        Next

        BuildHTMLTable = BuildHTMLTable & "</TR>"
    Next

    BuildHTMLTable = BuildHTMLTable & "</TABLE>"
End Function

[编辑]

这会将我上面函数中的概念集成到您的代码中。对您的代码进行了一些假设，例如在 B2 中您在某处有“replace_body_table”的文本。并且不确定您的电子邮件地址在 F 列中的确切位置，所以我让它在 F2 中查找。

Sub SendMassEmail()

    Dim StartRow, Endrow As Long
    StartRow = 3
    Endrow = Sheet1.UsedRange.Rows.Count + 1

    Dim mail_body_message As String
    Dim mail_body_table As String

    mail_body_message = Sheet2.Range("B2")

    mail_body_table = "<TABLE>"
    Dim iCurRow As Long
    For iCurRow = StartRow To Endrow
            mail_body_table = mail_body_table & "<TR>"
            mail_body_table = mail_body_table & "<TD>" & Sheet1.Range("E" & iCurRow) & "</TD>"
            mail_body_table = mail_body_table & "<TD>" & Sheet1.Range("G" & iCurRow) & "</TD>"
            mail_body_table = mail_body_table & "<TD>" & Format(Sheet1.Range("K" & iCurRow), "Currency") & "</TD>"
            mail_body_table = mail_body_table & "</TR>"
    Next
    mail_body_table = mail_body_table & "</TABLE>"

    mail_body_message = Replace(mail_body_message, "replace_body_table", mail_body_table)


    Call SendEmail(Sheet1.Range("F2"), "Test 2018", mail_body_message)
    'MsgBox "Email Send Complete"

End Sub

推荐阅读