Send Emails 10 TIMES FASTER with This Excel Hack! (7 Levels)
Last updated on November 22, 2024 By Victor Chan
Are you tired of sending emails one by one, copying and pasting the same content over and over?
Find out how to automate sending emails directly from Excel. We’ll start with simple formulas and build up to advanced VBA solutions.
By the end, you’ll have a powerful system that can send personalized emails with multiple attachments and embedded Excel data in just a few clicks.
You can watch my full video tutorial on YouTube here.
Level 1: Sending Emails with the HYPERLINK Formula
Level 2: Automating Emails with VBA
Level 3: Add a Single Attachment to Your Emails
Level 4: Send Multiple Attachments Per Email
Level 5: Single Attachment Picker
Level 6: Multi Attachment Picker
Level 7: Add Excel Range to Email Text as a Table
Download FREE Excel Workbook
Step 1: Sign up for free Click Here
Step 2: Log in for access Click Here
Step 3: Download file Email-Automation-Workbook.zip
Are you new to Excel VBA Macros?
• Find out how to enable and disable macros in Excel with this tutorial
• Save time and effort by copying VBA macros from one workbook to another with these instructions
Level 1: Sending Emails with the HYPERLINK Formula
The simplest way to send emails from Excel is by using the HYPERLINK formula. This approach creates a clickable link in your Excel sheet that opens your default mail client (e.g., Outlook) with pre-filled details.
Here’s how it works:
- Use the HYPERLINK function to create a “mailto:” link.
- Add recipient details, CC, BCC, subject, and body text directly into the formula.
- Add “friendly name” for what you want to link to be shown as (e.g. [Link])
- Click the link, and your email client will open, ready to send.
Here is the full formula:
=HYPERLINK("mailto:" & C5 & "?" & "&cc=" &D5 & "&bcc=" &E5 & "&subject=" &F5 & "&body=" &G5, "[Link]")
For easier reading you can enter the formula on different lines using ALT + Enter to add a line break.
And then press CTRL + SHIFT + U to expand the formula bar. Or drag the formula bar down to extend how many lines you can see.
This is what the formula looks like when you split it over several lines using ALT + Enter:
=HYPERLINK("mailto:"
& C5 & "?"
& "&cc=" &D5
& "&bcc=" &E5
& "&subject=" &F5
& "&body=" &G5,
"[Link]")
Remember to replace the cell references (C5, D5, E5, F5, G5) with your own.
But the formula method has drawbacks:
- 1. Limited Formatting: Adding line breaks in the email body requires using %0A, which can be tedious.
- 2. Single Email Limitation: You must click each link individually, making it inefficient for sending bulk personalized emails.
This method is great for quick, one-off emails, but if you need more power, it’s time to bring in VBA for real Excel automation.
Level 2: Automating Emails with VBA
Using VBA (Visual Basic for Applications), you can send multiple emails with just one click.
Here’s how to set it up:
- 1. Enable the Developer Tab: Right-click the ribbon, choose “Customize the Ribbon,” and enable the Developer tab.
- 2. Write Your VBA Code: Use the Visual Basic Editor to create a macro that automates the email-sending process.
- 3. Save as Macro-Enabled Workbook: Ensure your Excel file is saved as a macro-enabled workbook to retain your code.
- 4. Add Button: Create a button and assign the macro to run when the button is clicked. This makes it easy to run the macro without going into the VBA editor.
With VBA, you can:
- Loop through rows of data to send emails to multiple recipients.
- Customize each email with unique details like recipient name and subject.
- Preview emails before sending them.
Here is the VBA code for Level 2:
[VBA Code Box]
Option Explicit
Sub Level_2_Emails()
Dim emailApp As Object
Dim emailItem As Object
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim currentRow As Long
' Set up Outlook application
Set emailApp = CreateObject("Outlook.Application")
' Specify data range
Set ws = ThisWorkbook.Sheets("Level 2")
Set rng = ws.Range("B4")
' Find the last row with data
LastRow = ws.Cells(ws.Rows.count, rng.Column).End(xlUp).Row
' Automate emails using data range
For currentRow = 1 To (LastRow - rng.Row)
' Build email
Set emailItem = emailApp.CreateItem(0)
With emailItem
.To = rng.Offset(currentRow, 1)
.CC = rng.Offset(currentRow, 2)
.BCC = rng.Offset(currentRow, 3)
.Subject = rng.Offset(currentRow, 4)
.Body = rng.Offset(currentRow, 5)
End With
' Send or display email
emailItem.display
Next
' Cleanup
Set emailItem = Nothing
Set emailApp = Nothing
End Sub
This is a major step up from the manual HYPERLINK approach, but there’s more we can do—let’s add attachments!
Level 3: Add a Single Attachment to Your Emails
Sometimes you need to send more than just text. Attachments like reports, PDFs, or images are essential.
In Level 3, we extend the VBA code to include a single file attachment per email. This can be the same for all emails or different for each email.
Here’s how it works:
- Add a column to your Excel sheet for file paths.
- Copy and paste the file path for each attachment.
- Update the VBA code so it attaches each file specified in the sheet.
- Run the new VBA code.
Here is the VBA code for Level 3:
[VBA Code Box]
Option Explicit
Sub Level_3_Emails_Single_Attachment()
Dim emailApp As Object
Dim emailItem As Object
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim currentRow As Long
Dim AttachmentPath As String
' Set up Outlook application
Set emailApp = CreateObject("Outlook.Application")
' Specify data range
Set ws = ThisWorkbook.Sheets("Level 3")
Set rng = ws.Range("B4")
' Find the last row with data
LastRow = ws.Cells(ws.Rows.count, rng.Column).End(xlUp).Row
' Automate emails using data range
For currentRow = 1 To (LastRow - rng.Row)
' Build email
Set emailItem = emailApp.CreateItem(0)
With emailItem
.To = rng.Offset(currentRow, 1)
.CC = rng.Offset(currentRow, 2)
.BCC = rng.Offset(currentRow, 3)
.Subject = rng.Offset(currentRow, 4)
.Body = rng.Offset(currentRow, 5)
' Get attachment
AttachmentPath = rng.Offset(currentRow, 6).Value
If AttachmentPath <> "" Then
.Attachments.Add AttachmentPath
End If
End With
' Send or display email
emailItem.display
Next
' Cleanup
Set emailItem = Nothing
Set emailApp = Nothing
End Sub
Now, your emails can include a single attachment per recipient. While useful, what if you need to send multiple attachments?
Level 4: Send Multiple Attachments Per Email
What if you need to send more than one attachment in a single email?
Level 4 introduces the ability to include multiple attachments for each recipient.
Here’s how it works:
- Use a semicolon to separate file paths in the attachment column.
- Update the VBA code to process the file paths as an array.
- Loop through the array to attach each file to the email.
- Note: you can choose to send no attachments for any given email by keeping the corresponding cell in the attachment column empty.
Features:
- Supports multiple attachments for each email.
- Handles a variety of file types and sizes.
Benefits:
This level provides more flexibility, allowing you to include all relevant documents in a single email. It’s especially useful for complex workflows, such as sending detailed client reports or project deliverables.
Here is the VBA code for Level 4:
[VBA Code Box]
Option Explicit
Sub Level_4_Emails_Multiple_Attachments()
' Each attachment filename needs to be separated by a semi colon
Dim emailApp As Object
Dim emailItem As Object
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim currentRow As Long
Dim AttachmentPath As String
Dim AttachmentArray() As String
Dim i As Long
' Set up Outlook application
Set emailApp = CreateObject("Outlook.Application")
' Specify data range
Set ws = ThisWorkbook.Sheets("Level 4")
Set rng = ws.Range("B4")
' Find the last row with data
LastRow = ws.Cells(ws.Rows.count, rng.Column).End(xlUp).Row
' Automate emails using data range
For currentRow = 1 To (LastRow - rng.Row)
' Build email
Set emailItem = emailApp.CreateItem(0)
With emailItem
.To = rng.Offset(currentRow, 1)
.CC = rng.Offset(currentRow, 2)
.BCC = rng.Offset(currentRow, 3)
.Subject = rng.Offset(currentRow, 4)
.Body = rng.Offset(currentRow, 5)
' Get and process attachment(s)
AttachmentPath = rng.Offset(currentRow, 6).Value
If AttachmentPath <> "" Then
' Split the attachment paths using semicolon as a delimiter
AttachmentArray = Split(AttachmentPath, ";")
' Loop through each path and add it as an attachment
For i = LBound(AttachmentArray) To UBound(AttachmentArray)
.Attachments.Add Trim(AttachmentArray(i))
Next i
End If
End With
' Send or display email
emailItem.display
Next
' Cleanup
Set emailItem = Nothing
Set emailApp = Nothing
End Sub
Typing out file paths for attachments can be time-consuming and prone to errors. Let’s make this process more user-friendly with a file picker in Level 5.
Level 5: Single Attachment Picker
Typing file paths manually can be error-prone and time-consuming.
Level 5 simplifies this process with a file picker, allowing you to select files from your computer with a single click.
Here’s how it works:
- Add a “Pick Attachment” button in Excel.
- Create a new VBA subprocedure to open a file dialog box where you can select a file.
- Automatically insert the file path into the relevant cell.
- Assign the new VBA sub to the “Pick Attachment” button.
Features:
- Streamlines the process of adding attachments.
- Reduces errors caused by manual copy and paste of filepaths.
Benefits:
By eliminating the need to manually type file paths, this feature saves time and ensures accuracy. It’s perfect for users who frequently attach a single file to emails but want to avoid the hassle of copying and pasting file paths.
Here is the VBA code for Level 5:
[VBA Code Box]
Option Explicit
Sub Level_5_Emails_With_Single_Attachment_Picker()
' Each attachment filename needs to be separated by a semi colon
Dim emailApp As Object
Dim emailItem As Object
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim currentRow As Long
Dim AttachmentPath As String
Dim AttachmentArray() As String
Dim i As Long
' Set up Outlook application
Set emailApp = CreateObject("Outlook.Application")
' Specify data range
Set ws = ThisWorkbook.Sheets("Level 5")
Set rng = ws.Range("B4")
' Find the last row with data
LastRow = ws.Cells(ws.Rows.count, rng.Column).End(xlUp).Row
' Automate emails using data range
For currentRow = 1 To (LastRow - rng.Row)
' Build email
Set emailItem = emailApp.CreateItem(0)
With emailItem
.To = rng.Offset(currentRow, 1)
.CC = rng.Offset(currentRow, 2)
.BCC = rng.Offset(currentRow, 3)
.Subject = rng.Offset(currentRow, 4)
.Body = rng.Offset(currentRow, 5)
' Get and process attachment(s)
AttachmentPath = rng.Offset(currentRow, 6).Value
If AttachmentPath <> "" Then
' Split the attachment paths using semicolon as a delimiter
AttachmentArray = Split(AttachmentPath, ";")
' Loop through each path and add it as an attachment
For i = LBound(AttachmentArray) To UBound(AttachmentArray)
.Attachments.Add Trim(AttachmentArray(i))
Next i
End If
End With
' Send or display email
emailItem.display
Next
' Cleanup
Set emailItem = Nothing
Set emailApp = Nothing
End Sub
Sub Level_5_Pick_Attachment()
Dim FilePicker As FileDialog
Dim SelectedFile As String
' Create a FileDialog object as a File Picker
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
' Show the dialog box
If FilePicker.Show = -1 Then ' If the user selects a file
SelectedFile = FilePicker.SelectedItems(1) ' Get the first selected file
ActiveCell.Value = SelectedFile ' Insert the file path into the active cell
End If
' Clear the FilePicker object
Set FilePicker = Nothing
End Sub
Picking a single file is convenient, but what if you need to attach multiple files at once? Level 6 introduces multi-select functionality to save even more time.
Level 6: Multi Attachment Picker
Level 6 enhances the file picker by enabling you to select multiple files at once.
This feature is ideal for users who need to send emails with several attachments quickly.
Here’s how it works:
- Modify the VBA code to allow multi-select in the file picker.
- Automatically populate the cell with all selected file paths, separated by semicolons.
- Assign the updated VBA sub to the “Pick Attachment” button.
- Process the file paths using the existing VBA macro, which can already handle multiple attachments.
Features:
- Allows selection of multiple files in one go.
- Handles various file combinations with ease.
Benefits:
This improvement takes efficiency to the next level. Instead of selecting and entering file paths one by one, you can now batch-select multiple attachments, making this method perfect for detailed communications.
Here is the VBA code for Level 6:
[VBA Code Box]
Option Explicit
Sub Level_6_Emails_With_Multi_Attachment_Picker()
Dim emailApp As Object
Dim emailItem As Object
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim currentRow As Long
Dim AttachmentPath As String
Dim AttachmentArray() As String
Dim i As Long
' Set up Outlook application
Set emailApp = CreateObject("Outlook.Application")
' Specify data range
Set ws = ThisWorkbook.Sheets("Level 6")
Set rng = ws.Range("B4")
' Find the last row with data
LastRow = ws.Cells(ws.Rows.count, rng.Column).End(xlUp).Row
' Automate emails using data range
For currentRow = 1 To (LastRow - rng.Row)
' Build email
Set emailItem = emailApp.CreateItem(0)
With emailItem
.To = rng.Offset(currentRow, 1)
.CC = rng.Offset(currentRow, 2)
.BCC = rng.Offset(currentRow, 3)
.Subject = rng.Offset(currentRow, 4)
.Body = rng.Offset(currentRow, 5)
' Get and process attachment(s)
AttachmentPath = rng.Offset(currentRow, 6).Value
If AttachmentPath <> "" Then
' Split the attachment paths using semicolon as a delimiter
AttachmentArray = Split(AttachmentPath, ";")
' Loop through each path and add it as an attachment
For i = LBound(AttachmentArray) To UBound(AttachmentArray)
.Attachments.Add Trim(AttachmentArray(i))
Next i
End If
End With
' Send or display email
emailItem.display
Next
' Cleanup
Set emailItem = Nothing
Set emailApp = Nothing
End Sub
Sub Level_6_Pick_Attachments()
Dim FilePicker As FileDialog
Dim SelectedFiles As String
Dim i As Integer
' Create a FileDialog object as a File Picker
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.AllowMultiSelect = True ' Enable multiple file selection
.Title = "Select Attachments"
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box
If .Show = -1 Then ' If the user selects at least one file
SelectedFiles = "" ' Initialize the string
' Loop through all selected items
For i = 1 To .SelectedItems.count
SelectedFiles = SelectedFiles &.SelectedItems(i) &"; "
Next i
' Remove the trailing semicolon and space
If Len(SelectedFiles) > 2 Then
SelectedFiles = Left(SelectedFiles, Len(SelectedFiles) - 2)
End If
' Insert the concatenated file paths into the active cell
ActiveCell.Value = SelectedFiles
Else
MsgBox "No files were selected.", vbInformation
End If
End With
' Clear the FilePicker object
Set FilePicker = Nothing
End Sub
Attachments are one thing, but what if you want to include data directly in the email body? Level 7 focuses on embedding formatted Excel ranges into your emails for professional, data-rich messages.
Level 7: Add Excel Range to Email Text as a Table
The final level transforms your emails into dynamic, data-driven messages by embedding Excel ranges directly into the email body.
This allows you to include formatted tables in a professional, visually appealing way.
Here’s how it works:
- Use a macro to select the Excel range you want to include.
- Convert the range into HTML using VBA functions.
- Update your email body text to include the placeholder {Range}.
- Run the new macro to replace the {Range} placeholder in the email body with the HTML table.
Features:
- Retains formatting like fonts, colors, and cell sizes.
- Dynamically updates the email body based on the selected range.
Benefits:
This level is ideal for reporting, enabling you to send emails with embedded tables, charts, or summaries that look polished and professional.
Your recipients can view key data at a glance without opening attachments, making communication faster and more impactful.
Here is the VBA code for Level 7:
Sub: Send Emails with Range and Attachments
[VBA Code Box]
Option Explicit
Sub Level_7_Emails_With_Data_From_Range()
Dim emailApp As Object
Dim emailItem As Object
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim currentRow As Long
Dim rangeAddress As String
Dim emailBody As String
Dim dataRange As Range
Dim htmlTable As String
Dim AttachmentPath As String
Dim AttachmentArray() As String
Dim i As Long
Application.ScreenUpdating = False
' Set up Outlook application
Set emailApp = CreateObject("Outlook.Application")
' Specify data range
Set ws = ThisWorkbook.Sheets("Level 7")
Set rng = ws.Range("B4")
' Find the last row with data
LastRow = ws.Cells(ws.Rows.count, rng.Column).End(xlUp).Row
' Automate emails using data range
For currentRow = 1 To (LastRow - rng.Row)
' Create email object
Set emailItem = emailApp.CreateItem(0)
' Get {Range} address so we can replace {Range} placeholder with Excel data
rangeAddress = Trim(ws.Cells(rng.Row + currentRow, rng.Column + 7).Value)
' Skip if no range found
If rangeAddress = "" Then GoTo NextEmail
' Try to set the data range based on the address
On Error Resume Next
Set dataRange = Application.Range(rangeAddress)
If dataRange Is Nothing Then
MsgBox "Invalid range '" & rangeAddress & "' in row " & (rng.Row + currentRow - 1) & ".", vbExclamation
GoTo NextEmail
End If
On Error GoTo 0
' Convert the data range to an HTML table
htmlTable = Fn_RangeToHTML(dataRange)
' Set emailBody as HTML
emailBody = Fn_ConvertCellToHTML(ws.Cells(rng.Row + currentRow, rng.Column + 5))
' Replace {Range} placeholder in the email body with the HTML table
emailBody = Replace(emailBody, "{Range}", htmlTable)
With emailItem
.To = rng.Offset(currentRow, 1)
.CC = rng.Offset(currentRow, 2)
.BCC = rng.Offset(currentRow, 3)
.Subject = rng.Offset(currentRow, 4)
'.Body = rng.Offset(currentRow, 5)
.HTMLBody = emailBody ' Use HTMLBody for HTML content
' Get and process attachment(s)
AttachmentPath = rng.Offset(currentRow, 6).Value
If AttachmentPath <> "" Then
' Split the attachment paths using semicolon as a delimiter
AttachmentArray = Split(AttachmentPath, ";")
' Loop through each path and add it as an attachment
For i = LBound(AttachmentArray) To UBound(AttachmentArray)
.Attachments.Add Trim(AttachmentArray(i))
Next i
End If
' Send or display email
.display ' Use .Send to send automatically
End With
NextEmail:
' Cleanup for each email
Set emailItem = Nothing
Next currentRow
' Cleanup
Set emailApp = Nothing
Application.ScreenUpdating = True
End Sub
Sub: Pick Attachments
[VBA Code Box]
' Procedure to pick attachments and insert paths separated by semicolons
Sub Level_7_Pick_Attachments()
Dim FilePicker As FileDialog
Dim SelectedFiles As String
Dim i As Integer
' Create a FileDialog object as a File Picker
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.AllowMultiSelect = True ' Enable multiple file selection
.Title = "Select Attachments"
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box
If .Show = -1 Then ' If the user selects at least one file
SelectedFiles = "" ' Initialize the string
' Loop through all selected items
For i = 1 To .SelectedItems.count
SelectedFiles = SelectedFiles &.SelectedItems(i) &"; "
Next i
' Remove the trailing semicolon and space
If Len(SelectedFiles) > 2 Then
SelectedFiles = Left(SelectedFiles, Len(SelectedFiles) - 2)
End If
' Insert the concatenated file paths into the active cell
ActiveCell.Value = SelectedFiles
Else
MsgBox "No files were selected.", vbInformation
End If
End With
' Clear the FilePicker object
Set FilePicker = Nothing
End Sub
Sub: Pick Range
[VBA Code Box]
' Procedure to pick a range and insert its address (including sheet name) into the active cell
Sub Level_7_Pick_Range()
Dim selectedRange As Range
Dim rngAddress As String
Dim wsName As String
On Error Resume Next ' Handle the case where the user cancels the dialog
' Prompt the user to select a range
Set selectedRange = Application.InputBox( _
Prompt:="Please select a range:", _
Title:="Select Range", _
Type:=8) ' Type 8 = Range object
On Error GoTo 0 ' Reset error handling
' Check if a range was selected
If Not selectedRange Is Nothing Then
wsName = selectedRange.Worksheet.Name ' Get the worksheet name
' Enclose worksheet name in single quotes if it contains spaces or special characters
If InStr(1, wsName, " ") > 0 Or InStr(1, wsName, "'") > 0 Then
wsName = "'" &Replace(wsName, "'", "''") &"'" ' Handle single quotes within sheet names
End If
rngAddress = wsName &"!" &selectedRange.Address(True, True, xlA1, False) ' Get the full address with sheet name
ActiveCell.Value = rngAddress ' Insert the range address into the active cell
Else
MsgBox "No range was selected.", vbInformation
End If
End Sub
Function: Convert Excel range to HTML table
[VBA Code Box]
' Helper function to convert a range to an HTML table
Function Fn_RangeToHTML(rng As Range) As String
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
Dim rowCounter As Long
' Export the range to a temporary HTML file
TempFile = Environ$("temp") &"\" &"TempRange.html"
' Copy the range and create a new workbook to paste as HTML
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8 ' Paste column widths
.Cells(1).PasteSpecial xlPasteValues, , False, False ' Paste values
.Cells(1).PasteSpecial xlPasteFormats, , False, False ' Paste formats
' Copy row heights from the source range to the destination sheet
For rowCounter = 1 To rng.Rows.count
.Rows(rowCounter).RowHeight = rng.Rows(rowCounter).RowHeight
Next rowCounter
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
' Save the new workbook as HTML
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
' Read the HTML file
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) ' ForReading, TristateUseDefault
Fn_RangeToHTML = ts.ReadAll
ts.Close
' Left align range to match email body text
Fn_RangeToHTML = Replace(Fn_RangeToHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
' Delete the temporary HTML file
Kill TempFile
' Close the temporary workbook without saving
TempWB.Close SaveChanges:=False
' Cleanup
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Function: Convert cell contents to HTML
[VBA Code Box]
' Helper function to convert cell content to HTML
' Preserves formatting, spaces, and font sizes
Function Fn_ConvertCellToHTML(rng As Range) As String
Dim i As Long
Dim currentFont As Font
Dim html As String
Dim text As String
Dim previousColor As Long
Dim previousFontSize As Double
Dim previousBold As Boolean
Dim previousItalic As Boolean
Dim previousUnderline As Boolean
Dim colorChanged As Boolean
Dim fontSizeChanged As Boolean
Dim boldChanged As Boolean
Dim italicChanged As Boolean
Dim underlineChanged As Boolean
text = rng.Value
html = "<html><body style='white-space: pre-wrap;'>"
' Initialize previous formatting states
previousColor = -1 ' Invalid color
previousFontSize = -1 ' Invalid font size
previousBold = False
previousItalic = False
previousUnderline = False
For i = 1 To Len(text)
Set currentFont = rng.Characters(i, 1).Font
' Get current formatting attributes
Dim currentColor As Long
Dim currentFontSize As Double
Dim currentBold As Boolean
Dim currentItalic As Boolean
Dim currentUnderline As Boolean
currentColor = currentFont.color
currentFontSize = currentFont.Size
currentBold = currentFont.Bold
currentItalic = currentFont.Italic
currentUnderline = (currentFont.Underline > 0)
' Determine if any formatting attributes have changed
colorChanged = (currentColor <> previousColor)
fontSizeChanged = (currentFontSize <> previousFontSize)
boldChanged = (currentBold <> previousBold)
italicChanged = (currentItalic <> previousItalic)
underlineChanged = (currentUnderline <> previousUnderline)
' Handle Bold Formatting
If boldChanged Then
If currentBold Then
html = html &"<b>"
Else
html = html &"</b>"
End If
previousBold = currentBold
End If
' Handle Italic Formatting
If italicChanged Then
If currentItalic Then
html = html &"<i>"
Else
html = html &"</i>"
End If
previousItalic = currentItalic
End If
' Handle Underline Formatting
If underlineChanged Then
If currentUnderline Then
html = html &"<u>"
Else
html = html &"</u>"
End If
previousUnderline = currentUnderline
End If
' Handle Color and Font Size Changes
If colorChanged Or fontSizeChanged Then
' Close the previous if it's open
If previousColor <> -1 Or previousFontSize <> -1 Then
html = html &"</span>"
End If
' Determine if a new is needed
If currentColor <> RGB(0, 0, 0) Or currentFontSize <> 11 Then ' Assuming 11pt is default
html = html &"<span style='""">"
If currentColor <> RGB(0, 0, 0) Then
html = html &"color:" & Fn_ColorToHex(currentColor) &";"
End If
If currentFontSize <> 11 Then
html = html &"font-size:" & currentFontSize &"pt;"
End If
html = html &"'>"
End If
' Update previous color and font size
previousColor = currentColor
previousFontSize = currentFontSize
End If
' Add character, escaping special characters
Dim charText As String
Dim currentChar As String
currentChar = rng.Characters(i, 1).Text
' Replace spaces with to preserve them
If currentChar = "" Then
charText =
Else
charText = Replace(currentChar, &"&, &")
charText = Replace(charText, "<", "<")
charText = Replace(charText, ">", ">")
End If
html = html &charText
Next i
' Close any remaining open tags
' Close for color and font size
If previousColor <> -1 Or previousFontSize <> -1 Then
html = html &"</span>"
End If
' Close <b>, <i>, <u> tags if they are still open
If previousUnderline Then
html = html &"</u>"
End If
If previousItalic Then
html = html &"</i>"
End If
If previousBold Then
html = html &"</b>"
End If
' Replace line breaks with <br>
html = Replace(html, vbCrLf, "<br>")
html = Replace(html, vbLf, "<br>")
html = html &"</body></html>"
Fn_ConvertCellToHTML = html
End Function
Function: Convert color to Hex string
[VBA Code Box]
' Function to Convert VBA Color to Hex String
Function Fn_ColorToHex(color As Long) As String
Dim red As Long, green As Long, blue As Long
' Extract RGB components from the VBA color (stored as BGR)
red = color Mod 256
green = (color \ 256) Mod 256
blue = (color \ 65536) Mod 256
' Convert to hex string in #RRGGBB format
Fn_ColorToHex = "#" &Right("0" &Hex(red), 2) &_
Right("0" &Hex(green), 2) &_
Right("0" &Hex(blue), 2)
End Function
Level 7 completes the core functionality of our email automation system, enabling you to send personalized emails with embedded Excel data.
Bonus: Level 7 System Diagram (ChatGPT Prompt)
Understanding how all the pieces fit together can make troubleshooting and extending the system much easier.
To help with this, I created a system diagram that visually maps out how Level 7’s VBA code works.
And here’s the best part: I used ChatGPT to generate it. Let me show you how.
Here is the prompt I used with ChatGPT o1-mini to create a system diagram for Level 7’s Excel VBA code:
Write a VBA macro that takes the currently selected picture in the active workbook and resizes all other pictures in every worksheet of the active workbook to match the exact size and position of the selected picture. If no picture is selected, display a message box prompting the user to select a picture first and then exit the subroutine.
ChatGPT o1-mini thought for 7 seconds. Here is a screenshot of its thought process.
And it wasn’t able to create a visual diagram directly, so it created a structured textual representation to outline the code components and their interactions.
I put this text representation into the code module Level7_Diagram which you can find in the downloadable workbook.
What Next?
These seven levels of email automation give you powerful tools to simplify your work. From sending bulk emails to adding attachments and embedding Excel data, you can now handle repetitive tasks faster and more professionally.
Once you’ve set these systems up, they’ll save you hours of effort every time you use them. They’re reliable, efficient, and easy to adapt as your needs grow.
If you’re ready to learn more about VBA automation from the ground up, check out my Excel VBA training program. It’s designed to help you unlock the full potential of Excel and create automations that save you time and effort every day.
Hi, I'm Victor!
Are you struggling with complex Excel tasks? Feeling overwhelmed by spreadsheets that are hard to use?
Many people believe mastering Excel is about learning shortcuts, functions, and formulas. But this overlooks the importance of building practical, real-world applications. It's not just about knowing the tools. It's about using them effectively.
That's where I come in. You'll get a unique perspective to Excel training from me. I have over 20 years of experience at Deloitte and two global tech companies. And I know what can make a difference in your career.
Let me help you integrate Excel into your professional life. Starting today. Read one of my articles, watch one of my videos. Then apply the new technique to your work. You'll see the difference immediately!
Discover the PROVEN Blueprint for transforming your Excel skills, supercharging your productivity, and standing out in your career! My course helps you to learn Excel VBA and save hours of time even if you have zero prior experience with programming.
Solve tricky Excel problems and take your work to the next level! Get customized solutions for your unique needs. Save time and gain insights with truly expert Excel solutions from only $97 per task.
Get a clear overview of your project progress using the Excel project timeline. Use it to communicate the big picture, track task progress, and stay on top of your project goals. Stay organized with our project timeline!
Our cheat sheets provide quick and easy reference to commonly used Excel VBA concepts and code snippets.
Unlock new levels of productivity and efficiency with our cheat sheets, and write VBA code like a pro in no time.
RECOMMENDED READING
Are you looking to upskill and stay ahead of the curve? Excel is a powerful tool that keeps growing in demand. We round up the best online courses for learning Excel.
Are you looking to up your spreadsheet game? Excel is an invaluable tool that can help you stay organized and save time. From data analysis to budgets, Excel can do it all!
Today, having Excel skills is more critical than ever. Those who know how to use Excel are more likely to find higher-paying jobs. And get promoted faster.