MS Excel VBA

VBA Macro to Send Email from Excel with Table in Body

Send Email from Excel with Table in Body VBA Macro

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 = "<th>" & Worksheets("sheet1").Cells(1, iColCnt) & "</th>"
        Else
            aTableHeads = aTableHeads & "<th>" & Worksheets("sheet1").Cells(1, iColCnt) & "</th>"
        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 = "<tr>"       ' HTML <'tr'> tag to create table row.
    For iRows = 3 To aRowsCount
        For iColCnt = 1 To ColumnsCount
            ' Table data concatenated with HTML <td> tags.
            If (aTableData) = "" Then
                aTableData = "<td>" & Worksheets("Sheet1").Cells(iRows, iColCnt) & "</td>"
            Else
                aTableData = aTableData & "<td>" & Worksheets("Sheet1").Cells(iRows, iColCnt) & "</td>"
            End If
        Next iColCnt

        aTableData = aTableData & "</tr>"
    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 = "<style> table.edTable { width: 70%; font: 18px calibri; } table, table.edTable th, table.edTable td { border: solid 1px #494960; border-collapse: collapse; padding: 3px; text-align: center; } table.edTable td { background-color: #5a5f6f; color: #ffffff; font-size: 14px; } table.edTable th { background-color : #494960; color: #ffffff; } tr:hover td { background-color: #494960; color: #dddddd; } </style>"
    
    Dim sHTMLBody As String            ' The body (in HTML format) of the email. The table has a CSS class.
    sHTMLBody = aTableStyle & "<table class='edTable'><tr>" & aTableHeads & "</tr>" & _
            "<tr>" & aTableData & "</tr></table>"
            
    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 = "<th>" & Worksheets("sheet1").Cells(1, iColCnt) & "</th>"
        Else
            aTableHeads = aTableHeads & "<th>" & Worksheets("sheet1").Cells(1, iColCnt) & "</th>"
        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 = "<tr>"
				
			
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 = "<td>" & Worksheets("Sheet1").Cells(iRows, iColCnt) & "</td>"
            Else
                aTableData = aTableData & "<td>" & Worksheets("Sheet1").Cells(iRows, iColCnt) & "</td>"
            End If
        Next iColCnt

        aTableData = aTableData & "</tr>"
    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 = "<style> table.edTable { width: 70%; font: 18px calibri; } table, table.edTable th, table.edTable td { border: solid 1px #494960; border-collapse: collapse; padding: 3px; text-align: center; } table.edTable td { background-color: #5a5f6f; color: #ffffff; font-size: 14px; } table.edTable th { background-color : #494960; color: #ffffff; } tr:hover td { background-color: #494960; color: #dddddd; } </style>"
				
			
CSS style to the table.
				
					Dim sHTMLBody As String
sHTMLBody = aTableStyle & "<table class='edTable'><tr>" & aTableHeads & "</tr>" & _
            "<tr>" & aTableData & "</tr></table>"
				
			
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:
				
			
Clear all objects.

Leave a Comment

Your email address will not be published. Required fields are marked *


Scroll to Top