I recently received an email from a Client tasking me with how to send an email from Excel with an HTML Table in the Body (of the email) using VBA. The email body usually includes plain text data, in sections, and you can connect files. You can also send emails in different formats, like in the form of an HTML Table. I’ll show you how you can do this.
Source Code.
Option Explicit
Private Sub Email_in_html_format()
On Error GoTo ErrHandler
' Set the Outlook object.
Dim Outlook As Object
Set Outlook = CreateObject("Outlook.Application")
' Create email object.
Dim Email As Object
Set Email = Outlook.CreateItem(olMailItem)
'We'll now set the range (to extract email id).
Dim myrange, cell As Range
Set myrange = Worksheets("sheet1").Range("E1:E10" & Cells(Rows.Count, "B").End(xlUp).Row)
Dim STR As String ' Variable to store recipients email ids.
' Run loop to extract email id from the 5th column.
For Each cell In myrange
If Trim(cell.Offset(2, 0).Value) <> "" Then
If Trim(STR) = "" Then
STR = cell.Offset(2, 0).Value
Else
STR = STR & vbCrLf & ";" & cell.Offset(2, 0).Value
End If
End If
Next cell
Set myrange = Nothing ' Clear the range.
'>Now, let's get the columns for the table header.
Dim ColumnsCount, iColCnt As Integer ' Column counters.
Dim aTableHeads As String
ColumnsCount = Worksheets("sheet1").UsedRange.Columns.Count - 1
For iColCnt = 1 To ColumnsCount
' Table header concatenated with HTML < th > tags.
If (aTableHeads) = "" Then
aTableHeads = "" & Worksheets("sheet1").Cells(1, iColCnt) & " "
Else
aTableHeads = aTableHeads & "" & Worksheets("sheet1").Cells(1, iColCnt) & " "
End If
Next iColCnt
' **
'Finally you get the table data.
Dim aRowsCount, iRows As Integer ' Row counters.
Dim aTableData As String
aRowsCount = Worksheets("sheet1").UsedRange.Rows.Count
aTableData = "" ' HTML <'tr'> tag to create table row.
For iRows = 3 To aRowsCount
For iColCnt = 1 To ColumnsCount
' Table data concatenated with HTML tags.
If (aTableData) = "" Then
aTableData = " " & Worksheets("Sheet1").Cells(iRows, iColCnt) & " "
Else
aTableData = aTableData & "" & Worksheets("Sheet1").Cells(iRows, iColCnt) & " "
End If
Next iColCnt
aTableData = aTableData & " "
Next iRows
' *****
Dim sSubject As String ' The subject for the email.
sSubject = Worksheets("sheet1").Cells(1, 1).Value
' **Add CSS style to the table.
Dim aTableStyle As String
aTableStyle = ""
Dim sHTMLBody As String ' The body (in HTML format) of the email. The table has a CSS class.
sHTMLBody = aTableStyle & " " & aTableHeads & " " & _
"" & aTableData & "
"
With Email
' Assign all email address to the property,In-addition, you can add CC or BCC/.
.To = STR
.Subject = sSubject
.HTMLBody = sHTMLBody
.Display ' Display outlook message window.
'.Send ' Send the email, when you are done i stop it.
End With
' Clear all objects.
Set Email = Nothing: Set Outlook = Nothing
ErrHandler:
'
End Sub
Code Explanation
Option Explicit
(beginning of a module) force yourself to declare all the variables
On Error GoTo ErrHandler
Error Handling process occurs when writing code, before any errors actually occur.
Dim Outlook As Object
Set Outlook = CreateObject("Outlook.Application")
Set the Outlook object
Dim Email As Object
Set Email = Outlook.CreateItem(olMailItem)
Create email object.
Dim myrange, cell As Range
Set myrange = Worksheets("sheet1").Range("E1:E10" & Cells(Rows.Count, "B").End(xlUp).Row)
defined variable and set the range (to extract email id).
Dim STR As String
Variable to store recipients email id
For Each cell In myrange
If Trim(cell.Offset(2, 0).Value) <> "" Then
If Trim(STR) = "" Then
STR = cell.Offset(2, 0).Value
Else
STR = STR & vbCrLf & ";" & cell.Offset(2, 0).Value
End If
End If
Next cell
Run loop to extract email id from the 5th column
Set myrange = Nothing
Clear the range
im ColumnsCount, iColCnt As Integer
Dim aTableHeads As String
get the columns for the table header
ColumnsCount = Worksheets("sheet1").UsedRange.Columns.Count - 1
For iColCnt = 1 To ColumnsCount
Column counters
If (aTableHeads) = "" Then
aTableHeads = "" & Worksheets("sheet1").Cells(1, iColCnt) & " "
Else
aTableHeads = aTableHeads & "" & Worksheets("sheet1").Cells(1, iColCnt) & " "
End If
Next iColCnt
Table header concatenated with HTML tags.
Dim aRowsCount, iRows As Integer
Dim aTableData As String
aRowsCount = Worksheets("sheet1").UsedRange.Rows.Count
Row counters.
aTableData = "" HTML tag to create table row
For iRows = 3 To aRowsCount
For iColCnt = 1 To ColumnsCount
Loop row 3 to last row
If (aTableData) = "" Then
aTableData = "" & Worksheets("Sheet1").Cells(iRows, iColCnt) & " "
Else
aTableData = aTableData & "" & Worksheets("Sheet1").Cells(iRows, iColCnt) & " "
End If
Next iColCnt
aTableData = aTableData & "
"
Next iRows
Table data concatenated with HTML tags
Dim sSubject As String
sSubject = Worksheets("sheet1").Cells(1, 1).Value
The subject for the email
Dim aTableStyle As String
aTableStyle = ""
CSS style to the table.
Dim sHTMLBody As String
sHTMLBody = aTableStyle & " " & aTableHeads & " " & _
"" & aTableData & "
"
The body (in HTML format) of the email. The table has a CSS class
With Email
.To = STR
.Subject = sSubject
.HTMLBody = sHTMLBody
.Display ' Display outlook message window.
'.Send ' Send the email, when you are done i stop it.
End With
Assign all email address to the property,In-addition, you can add CC or BCC/.
Set Email = Nothing: Set Outlook = Nothing
ErrHandler: