Динамически генерировать HTML-таблицу, вложенную в VBA Email Generation

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, содержащей данные в указанной области.

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

[EDIT]

Это интегрирует понятия из моей функции выше в ваш код. Сделал некоторые предположения о вашем коде, как в 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