How to create a table in Excel VBA to Email?

Question

I send schedules from Excel every week and I want to convert the data to a table where the week number is one merged cell at the top and the day and date are at the top of each column.

I don't know how to rewrite the mail body message as a table. The code probably has a lot of unnecessary strings but it works. I'd like to add that I am VERY new to VBA, or any coding at all for that matter, and still learning.

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.Body = mail_body
    olMail.Send

End Sub
Sub SendSchedules()

row_number = 2

Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim replace_Monday As String
    Dim replace_Tuesday As String
    Dim replace_Wednesday As String
    Dim replace_Thursday As String
    Dim replace_Friday As String
    Dim replace_Saturday As String
    Dim replace_Sunday As String


    mail_body_message = ActiveSheet.Range("J1") & vbNewLine & ActiveSheet.Range("C1") & " " & ActiveSheet.Range("C2") & vbNewLine & ActiveSheet.Range("D1") & " " & ActiveSheet.Range("D2") & vbNewLine & ActiveSheet.Range("E1") & " " & ActiveSheet.Range("E2") & vbNewLine & ActiveSheet.Range("F1") & " " & ActiveSheet.Range("F2") & vbNewLine & ActiveSheet.Range("G1") & " " & ActiveSheet.Range("G2") & vbNewLine & ActiveSheet.Range("H1") & " " & ActiveSheet.Range("H2") & vbNewLine & ActiveSheet.Range("I1") & " " & ActiveSheet.Range("I2")
    full_name = ActiveSheet.Range("B" & row_number)
    mon_day = ActiveSheet.Range("C" & row_number)
    tues_day = ActiveSheet.Range("D" & row_number)
    wednes_day = ActiveSheet.Range("E" & row_number)
    thurs_day = ActiveSheet.Range("F" & row_number)
    fri_day = ActiveSheet.Range("G" & row_number)
    satur_day = ActiveSheet.Range("H" & row_number)
    sun_day = ActiveSheet.Range("I" & row_number)
    week_number = ActiveSheet.Range("K2")


    mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
    mail_body_message = Replace(mail_body_message, "replace_week_number", week_number)
    mail_body_message = Replace(mail_body_message, "replace_Monday", mon_day)
    mail_body_message = Replace(mail_body_message, "replace_Tuesday", tues_day)
    mail_body_message = Replace(mail_body_message, "replace_Wednesday", wednes_day)
    mail_body_message = Replace(mail_body_message, "replace_Thursday", thurs_day)
    mail_body_message = Replace(mail_body_message, "replace_Friday", fri_day)
    mail_body_message = Replace(mail_body_message, "replace_Saturday", satur_day)
    mail_body_message = Replace(mail_body_message, "replace_Sunday", sun_day)
        MsgBox mail_body_message
    Call SendEmail(ActiveSheet.Range("A" & row_number), "Schedule Week 1", mail_body_message)
Loop Until row_number = 12

End Sub

Nothing wrong with this code, but now I want to take this information and create a table out of it. Although I'm worried I need to re-write the entire thing, I'm not sure how.

Answer 1

There are many ways to create tables in excel, but I can only think of two good methods for emailing them.

You could use VBA to setup a temporary excel spreedsheet that formats the table in the correct format. At this point, then you can simple copy and paste the entire thing into an HTML email using VBA.

Or, with VBA you could simply generate your entire body of text using HTML and then send the entire HTML string to your email body.

I have used the HTML route many times, and it can save a ton of time and it is much more useful.

Edit: Here is an example of using HTML, it's pretty rough and I wrote it in my early days. Please note that this was modified from a use-case I have with it. So you might have to tweak it a bit.

Sub Dealer_Email(Sheet As String, Name As Variant, Recipient As Variant, Subject As Variant, _
Mon as Variant, Tues as Variant, Wednesday as Variant, Thurs as Variant, _
Friday as Variant, Optional Copy As String, Optional Blind_Copy As String, _
    Optional Attach As String)
' Sheet = the Sheet name in which you wish to pull data from (this was designed for multiple sheets with identical layouts.
'Name = the Name in which will be entered into the generated email
'Recipient = the email address
'Subject = the subject line
'Optional Copy = If you wish to 'cc' someone on the email
'Optional Blind_copy = adds someone to 'bcc' on the email
'Optional attachment = You can define a file to be attached to the email 
' Parts of this function came from https://www.rondebruin.nl/
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Dim x, y As Variant
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(Sheet)
strbody = "<table>"
    strbody = strbody & _
        "<tr>" & _
            "<td> | </td>" & _
            "<td>" & Mon & "</td>" & _
            "<td> | </td>" & _
            "<td>" & Tues & "</td>" & _
            "<td> | </td>" & _
            "<td>" & Wednes & "</td>" & _
            "<td> | </td>" & _
            "<td>" & Thurs & "</td>" & _
            "<td> | </td>" & _
            "<td>" & Fri & "</td>" & _
            "<td> | </td>" & _
            "<td>" & Sat & "</td>" & _
            "<td> | </td>" & _
            "<td>" & Sun & "</td>" & _
            "<td> | </td>" & "</tr></table>"

strbody = "<font>Good Day " & Name & ",<br><br>" & _
          "Insert Message Here...<br>" & _
          strbody & _
          "<br>" & _
          "If you have any questions, feel free to contact me.</font>"

          2
On Error Resume Next

With OutMail
    .Display
    .To = Recipient
    .CC = Copy
    .BCC = Blind_Copy
    .Subject = Subject
    .htmlbody = strbody & .htmlbody
    .Attachment = Attach
End With

OutMail.Display

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Note that this does require Microsoft Outlook to work. Part of this code did come from https://www.rondebruin.nl/.

You could easily add a loop, and have this repeat as needed for each line within the html chart.

EDIT (SECOND TIME AROUND):

Sub SendSchedules()
Dim row_number As Integer

row_number = 2

Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim replace_Monday As String
    Dim replace_Tuesday As String
    Dim replace_Wednesday As String
    Dim replace_Thursday As String
    Dim replace_Friday As String
    Dim replace_Saturday As String
    Dim replace_Sunday As String

    full_name = ActiveSheet.Range("B" & row_number).Value
    mon_day = ActiveSheet.Range("C" & row_number).Value
    tues_day = ActiveSheet.Range("D" & row_number).Value
    wednes_day = ActiveSheet.Range("E" & row_number).Value
    thurs_day = ActiveSheet.Range("F" & row_number).Value
    fri_day = ActiveSheet.Range("G" & row_number).Value
    satur_day = ActiveSheet.Range("H" & row_number).Value
    sun_day = ActiveSheet.Range("I" & row_number).Value
    week_number = ActiveSheet.Range("K2").Value


strbody = "<table>"
    mail_body_message = strbody & _
        "<tr>" & _
            "<td> Full Name: </td>" & _
            "<td>" & full_name & "</td></tr>" & _
            "<tr><td>Week Number: </td>" & _
            "<td>" & week_number & "</td></tr>" & _
            "<tr><td>Monday: </td>" & _
            "<td>" & mon_day & "</td></tr>" & _
            "<tr><td>Tuesday: </td>" & _
            "<td>" & tues_day & "</td></tr>" & _
            "<tr><td>Wednesday: </td>" & _
            "<td>" & wednes_day & "</td></tr>" & _
            "<tr><td>Thursday: </td>" & _
            "<td>" & thurs_day & "</td></tr>" & _
            "<tr><td>Friday: </td>" & _
            "<td>" & fri_day & "</td></tr>" & _
            "<tr><td>Saturday: </td>" & _
            "<td>" & satur_day & "</td></tr>" & _
            "<tr><td>Sunday: </td>" & _
            "<td>" & sun_day & "</td></tr>" & _
            "</table>"

        MsgBox mail_body_message
Loop Until row_number = 12

You will need to change another line of code from:

    olMail.Body = mail_body

to the following.

    olMail.htmlbody = mail_body & .htmlbody

I hope this helps out.