As a VBA developer you may frequently come cross with a requirement of sending an email through Outlook along with an HTML table inside email body. Adding an HTML table in email body is very simple task if you do manually, just copy the range in Excel and paste it on email. It is little difficult in VBA to copy Excel range into email body. To convert Excel range into HTML table, you need to play with HTML tags. Below is the code which can make your life easy
'Following function converts Excel range to HTML table
Public Function ConvertRangeToHTMLTable(rInput As Range) As String
'Declare variables
Dim rRow As Range
Dim rCell As Range
Dim strReturn As String
'Define table format and font
strReturn = "<Table border='1' cellspacing='0' cellpadding='7' style='border-
collapse:collapse;border:none'> "
'Loop through each row in the range
For Each rRow In rInput.Rows
'Start new html row
strReturn = strReturn & " <tr align='Center'; style='height:10.00pt'> "
For Each rCell In rRow.Cells
'If it is row 1 then it is header row that need to be bold
If rCell.Row = 1 Then
strReturn = strReturn & "<td valign='Center' style='border:solid
windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'><b>" & rCell.Text & "</b>
</td>"
Else
strReturn = strReturn & "<td valign='Center' style='border:solid
windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'>" & rCell.Text & "</td>"
End If
Next rCell
'End a row
strReturn = strReturn & "</tr>"
Next rRow
'Close the font tag
strReturn = strReturn & "</font></table>"
'Return html format
ConvertRangeToHTMLTable = strReturn
End Function
Below Excel Macro creates an email in outlook and call the above function to add Excel Range as HTML Table in Email Body
'This function creates an email in Outlook and call the ConvertRangeToHTMLTable function
to add Excel range as HTML table in Email body
Sub CreateOutlookEmail()
'Declare variable
Dim objMail As Outlook.MailItem
'Create new Outlook email object
Set objMail = Outlook.CreateItem(olMailItem)
'Assign To
objMail.To = "[email protected]"
'Assign Cc
objMail.CC = "[email protected]"
'Assign Subject
objMail.Subject = "Test Email"
'Define HTML email body
'Tip: Here i have converted range A1:F20 of Sheet1 in HTML table, you can modify the
same as per your requirement
objMail.HTMLBody = "<P><font size='2' face='Calibri' color='black'>This is a test email</font></P>" & ConvertRangeToHTMLTable(Sheet1.Range("A1:F20"))
objMail.HTMLBody = "<P><font size='2' face='Calibri' color='black'>This is a test email</font></P>" & ConvertRangeToHTMLTable(Sheet1.Range("A1:F20"))
'Show the email to User
objMail.Display
'Send the email
'objMail.Send
'Close the object
Set objMail = Nothing
End Sub
It is worth to mention that you must have MS Outlook installed in your system to use this code and you also need to add Outlook reference (Microsoft Outlook XX.X Object Library) in Excel VBA from Menu Bar (Tools>References…). You can read this post to see how to add Outlook Object Library in Excel Reference.
To use this code in your Excel file, follow below steps:
1. Open an Excel file
2. Press Alt+F11
3. Insert a Module (Insert>Module) from menu bar
4. Paste the code in the module
5. Now add a shape in Excel sheet
6. Give a name to the shape like ‘Create Email’
7. Right click on the shape and select ‘Assign Macro…’
8. Select ‘CreateOutlookEmail’ from the list and click on ‘Ok’ button
9. Done
Hope you liked this article !!
Subscribe our blog for new amazing excel tricks.
Click to below for some more interesting tricks and learning:
Please leave your valuable comments in Comments section:
We are offering Excel VBA Course for Beginners to Experts at discounted prices. The courses includes On Demand Videos, Practice Assignments, Q&A Support from our Experts. Also after successfully completion of the certification, will share the success with Certificate of Completion
This course is going to help you to excel your skills in Excel VBA with our real time case studies.
Lets get connected and start learning now. Click here to Enroll.
VBA code that will sum cells by its color through excel function. This code will really help in making the analysis and presentation better.
Did you come across any requirement where you want the user to interact with a sheet only through VBA Form? Here is a simple code which can help you.
In MS Access, the best way to create a multiuser tool is to divide your solution. One part acts as interface and other one acts as database. You can have multiple copies of the interface distributed to users which are connected to central MS Access database saved at common shared drive. To connect the interface to database, you can use link table feature (Access>External Data>Import & Link) available in MS Access. Below is a commonly required VBA code which helps the developers to re-link MS Access linked tables when the database is renamed or moved to other location
Lock Cells to avoid editing, Hide Formulas Sometimes you create amazing projects, dashboards however people can make mistakes and edit the calculations, formats what you have made. Still you can protect the sheets, workbooks and…
VBA to Browse Outlook Folder Outlook is most commonly used emailing application used in the world. Many people spend their entire day on Outlook applications to read and respond to emails. To automate certain rule-based…
This Excel VBA Code helps to Get User Name. Here is an example environ(username) or Application.username.This macro gets the username from active directory.
thank you I was looking for this code from sometime
Corrrect the 1st code
Declare the variable “rInput”.
Thanks for your response Sandeep. As we checked rInput is already declared as input parameter of ConvertRangeToHTMLTable function; hence need not to be declared separately.
Hello – I’ve been working with this but I can’t figure out how to change the header row to bold. I’m using the function for 3 seperate tables on the same sheet and using If rCell.Row = 1 this is the first row in the sheet, not in the range? How do I select the first row in the range?
Hi Jason,
Can you try to replace
If rCell.Row = 1 Then
withIf rCell.Row - rInput.Row = 0 Then
.Regards
ExcelSirJi Team
hello, i copy and pasted your code. in the email, i got a super small table with no code. the problem is rCell.Text is not displaying the text. When i replace rCell.Text with something else, like “hello”, it works perfectly.
Hi Gordon,
We are not able to reproduce the error of small text. The error seems to be more related to data that you are trying to convert in HTML Table. Can you try the same code with any other Excel file?
Regards
ExcelSirJi
Hello – this macro works perfectly thank you! However there are empty rows in my range that I am converting to a table, but when I do the macro the table does not have blank rows. Is there a way I can leave the blank cells as blank rows in the output table?
Hi Morgan,
You can try following code to fix the height of the row in table:
Regards,
Your Excel Mate
Hello,
great, that’s exactly what I was looking for.
I added a small function for wrap text in the cells.
BR Karl-Heinz
Function WrapText(strValue As String) As String
‘*Declare variables
Dim strtxt As String, i As Long, MyValues
‘*Split value from Cell with chr(10) to get more lines
MyValues = Split(strValue, Chr(10))
‘*Create temp string with breaks
For i = LBound(MyValues) To UBound(MyValues)
strtxt = strtxt & IIf(Len(strtxt) > 0, “”, “”) & MyValues(i)
Next i
WrapText = strtxt
End Function
Public Function ConvertRangeToHTMLTable(rInput As Range) As String
‘*Declare variables
Dim rRow As Range
Dim rCell As Range
Dim strReturn As String
Dim strValue As String
‘*Define table format and font
strReturn = ” ”
‘*Loop through each row in the range
For Each rRow In rInput.Rows
‘*Start new html row
strReturn = strReturn & ” ”
For Each rCell In rRow.Cells
‘*If it is row 1 then it is header row that need to be bold
If rCell.Row = 1 Then
‘*Check if wrap-text is available
If InStr(1, rCell.Value, Chr(10), vbBinaryCompare) > 0 Then strValue = WrapText(rCell.Value) Else strValue = rCell.Value
strReturn = strReturn & “” & strValue & “”
Else
If InStr(1, rCell.Value, Chr(10), vbBinaryCompare) > 0 Then strValue = WrapText(rCell.Value) Else strValue = rCell.Value
strReturn = strReturn & “” & strValue & “”
End If
Next rCell
‘*End a row
strReturn = strReturn & “”
Next rRow
‘*Close the font tag
strReturn = strReturn & “”
‘*Return html format
ConvertRangeToHTMLTable = strReturn
End Function
Thanks for the value addition 🙂