Question

我正在尝试创建一封包含正文和表格的电子邮件，该表格会根据给定的数据集自动生成。现在，我将数据从具有所有输入的单独工作表中拉出，然后您只需从下拉列表中选择人员名称，数据就会自动填充。我希望将数据从所需的列拉到电子邮件正文中间的表中。但是，我不知道如何使以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

Answer 1

不久前写了类似的东西。

此函数将返回带有HTML表的字符串，该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

VBA电子邮件生成中内置的动态生成HTML表

1 个答案: