CODEWITHSUNDEEP
htmlvbaexcel
Anonymous
Anonymous

Reputation: 1

Dynamically Generate HTML Table enbedded in VBA Email Generation

I am trying to create an email with body text and a table that automatically generates from a given set of data. Right now, I have the data pulling from a separate sheet with all the inputs, then you can simply select a persons name from the drop down list and the data auto populates. I was hoping to pull the data from the columns needed into a table in the middle of the email body. However, I don't know how to make the table formatted in HTML dynamic so that it can either have 2,3,1 row of data depending on what shows up.

The other option I would want is for VBA to automatically find alike data based on names in a list and automatically pull the data based on that but I don't know if that is possible.

I am very knew to VBA - only taught myself about 2 weeks ago for the purpose of this email, so I'm not 100% familiar with all the options. However, the one issue I was having with the loop on the drop-down layout was that to have the information auto-generate the formulas had to be pasted into the columns so technically they are not blank rows.

I also have the message that I need inserted pulling from a cell in a separate sheet because I need to be able to HTML format it. Again I'm not sure if any of the stuff I am doing is the best way, but I couldn't figure out a better way.

here is my code: 

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

Upvotes: 0

Views: 933

Answers (1)

JosephC
JosephC

Reputation: 929

Wrote something similar to this a while ago.

This function will return a string with an HTML table containing the data within the specified area.

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]

This will integrate the concepts in my function above into your code. Made some assumptions on your code like that in B2 you somewhere you have text that says "replace_body_table". And wasn't sure exactly where in F column you had your email address so I have it looking in F2 for it.

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

Upvotes: 1

Related Questions