...

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
Seraphinite AcceleratorOptimized by Seraphinite Accelerator
Turns on site high speed to be attractive for people and search engines.