How to Use Excel VBA to Paste Range into Email Body (3 Methods)

Get FREE Advanced Excel Exercises with Solutions!

If you are working with an Excel worksheet that you need to update and share with other people via email on a frequent basis, VBA macro in Excel can reduce the hassle of sending the file repeatedly with a single click. In this tutorial, I will show you how to use Excel VBA to paste range into the email body without even having to open your mail inbox or app.


Use Excel VBA to Paste Range into Email Body: 3 Methods

Let’s assume a scenario where we have an Excel file that contains information about the employees of a company. The worksheet has the Name, Age, Gender, Date of Birth, and the State each of them comes from. We will copy and then paste the range of this worksheet into the email body using VBA. The image below shows the range from the worksheet that we have pasted into the email body.

Paste Range as Image into Email Body Using VBA in Excel


Method 1: Paste Range as Image into Email Body Using VBA in Excel

Step 1:

  • First, we have to log in to our Outlook mail app. None of the VBA codes here will work if you do not use Outlook as the mail app. So, we will first log in to the Outlook app. Insert your email address in the input box of the app and click on Connect just like the image below.

Paste Range as Image into Email Body Using VBA in Excel

Step 2:

  • We will now select the cell range that we want to paste into the email body. We have selected the entire data range of the worksheet.

Paste Range as Image into Email Body Using VBA in Excel

  • Now, we will select Visual Basic from the Developer. We can also press ALT+F11 to open it.

Paste Range as Image into Email Body Using VBA in Excel

  • Now, click on the Insert button and select Module.

Paste Range as Image into Email Body Using VBA in Excel

  • Then, write down the following code in the window that appears.
Sub Paste_Range_Outlook()
    Dim rng As Range
    Dim Outlook As Object
    Dim OutlookMail As Object
    Set rng = Nothing
    On Error Resume Next
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If rng Is Nothing Then
        MsgBox "Not a range or protected sheet" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set Outlook = CreateObject("Outlook.Application")
    Set OutlookMail = Outlook.CreateItem(0)
    On Error Resume Next
    With OutlookMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Excel Data you requested for"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    End With
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutlookMail = Nothing
    Set Outlook = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim obj As Object
    Dim txtstr As Object
    Dim File As String
    Dim WB As Workbook
    File = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set WB = Workbooks.Add(1)
    With WB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With WB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=File, _
         Sheet:=WB.Sheets(1).Name, _
         Source:=WB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set obj = CreateObject("Scripting.FileSystemObject")
    Set txtstr = obj.GetFile(File).OpenAsTextStream(1, -2)
    RangetoHTML = txtstr.readall
    txtstr.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    WB.Close savechanges:=False
    Kill File
    Set txtstr = Nothing
    Set obj = Nothing
    Set WB = Nothing
End Function
  • Now, click on the Run ().

Paste Range as Image into Email Body Using VBA in Excel

  • If a window named Macro appears, just click on Run from that window.

click on Run

  • Finally, we will see that a window of the Outlook mail app appears with a new mail that has the entire range we have copied from the worksheet in its body.

Paste Range as Image into Email Body Using VBA in ExcelRead More: How to Send Email from Excel with Body Using a Macro


Method 2: Use VBA to Copy and Paste Range as Image into Email

Alternatively, we can also copy and paste the range as an image format into the mail body. Let’s see how we can do that.

Step 1:

  • First, we will insert a new Module.

 Use VBA to Copy and Paste Range as Image into Email

Step 2:

  • Then, we will write down the following code in the window that appears.
Sub PasteRangeinMail()
Dim FilePath As String
Dim Outlook As Object
Dim OutlookMail As Object
Dim HTMLBody As String
Dim rng As Range
On Error Resume Next
Set rng = Selection
If rng Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set Outlook = CreateObject("outlook.application")
Set OutlookMail = Outlook.CreateItem(olMailItem)
Call createImage(ActiveSheet.Name, rng.Address, "RangeImage")
FilePath = Environ$("temp") & "\"
HTMLBody = "<span LANG=EN>" _
& "<p class=style1><span LANG=EN><font FACE=Times New Roman SIZE=4>" _
& "Dear Concerned," _
& "<br>" _
& "This is the Excel data you requested for:<br> " _
& "<br>" _
& "<img src='cid:RangeImage.jpg'>" _
& "<br>" _
& "<br>Kind Regards!!!!!</font></span>"
With OutlookMail
.Subject = ""
.HTMLBody = HTMLBody
.Attachments.Add FilePath & "RangeImage.jpg", olByValue
.To = "[email protected]"
.CC = " "
.Display
End With
End Sub
Sub createImage(SheetName As String, rngAddrss As String, nameFile As String)
Dim rngJpg As Range
Dim Shape As Shape
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set rngJpg = ThisWorkbook.Worksheets(SheetName).Range(rngAddrss)
rngJpg.CopyPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(rngJpg.Left, rngJpg.Top, rngJpg.Width, rngJpg.Height)
.Activate
For Each Shape In ActiveSheet.Shapes
Shape.Line.Visible = msoFalse
Next
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set rngJpg = Nothing
End Sub
  • Now, click on the Run ().

 Use VBA to Copy and Paste Range as Image into Email

  • If a window named Macro appears, just click on Run from that window.

click on Run

  • Finally, we will see that a window of the Outlook mail app appears with a new mail that has the entire range we have copied from the worksheet as a jpg image in its body.

Range in New Mail

Read More: VBA to Generate Multiple Lines in Email Body in Excel


Method 3: Copy Ranges From Multiple Worksheets and Paste as Images into Email Using VBA

We can also copy multiple ranges from different worksheets and then paste them as images into the body of an email using VBA. We have to do the following.

Step 1:

  • First, we will select the ranges we want to paste into the body of an email. We have chosen the ranges under the Gender and Date of Birth columns from the first worksheet.

Copy Ranges From Multiple Worksheets and Paste as Images into Email Using VBA

  • Then, we selected the range under the Name column from the second worksheet.

Copy Ranges From Multiple Worksheets and Paste as Images into Email Using VBA

Step 2:

  • Then, we will write down the following code in the window that appears.
Sub PasteMultipleRangeinMail()
Dim FilePath As String
Dim Outlook As Object
Dim OutlookMail As Object
Dim HTMLBody As String
Dim rng As Range
Dim Sheet As Worksheet
Dim AcSheet As Worksheet
Dim FileName As String
Dim Src As String
On Error Resume Next
FilePath = Environ$("temp") & "\RangeImage\"
If Len(VBA.Dir(FilePath, vbDirectory)) = False Then
VBA.MkDir FilePath
End If
Set AcSheet = Application.ActiveSheet
For Each Sheet In Application.Worksheets
Sheet.Activate
Set rng = Sheet.Application.Selection
If rng.Cells.Count > 1 Then
Call createJpg(Sheet.Name, rng.Address, "DashboardFile" & VBA.Trim(VBA.Str(Sheet.Index)))
End If
Next
AcSheet.Activate
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set Outlook = CreateObject("outlook.application")
Set OutlookMail = Outlook.CreateItem(olMailItem)
Src = ""
FileName = Dir(FilePath & "*.*")
Do While FileName <> ""
Src = Src + VBA.vbCrLf + "<img src='cid:" + FileName + "'><br>"
FileName = Dir
If FileName = "" Then Exit Do
Loop
HTMLBody = "<span LANG=EN>" _
& "<p class=style1><span LANG=EN><font FACE=Times New Roman SIZE=4>" _
& "Dear Concerned," _
& "<br>" _
& "This is the Excel data you requested for:<br> " _
& "<br>" _
& Src _
& "<br>Best Regards!</font></span>"
With OutlookMail
.Subject = ""
.HTMLBody = HTMLBody
FileName = Dir(FilePath & "*.*")
Do While FileName <> ""
.Attachments.Add FilePath & FileName, olByValue
FileName = Dir
If FileName = "" Then Exit Do
Loop
.To = " "
.CC = " "
.Display
End With
If VBA.Dir(FilePath & "*.*") <> "" Then
VBA.Kill FilePath & "*.*"
End If
End Sub
Sub createJpg(SheetName As String, rngAddrss As String, nameFile As String)
Dim rngPic As Range
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set rngPic = ThisWorkbook.Worksheets(SheetName).Range(rngAddrss)
rngPic.CopyPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(rngPic.Left, rngPic.Top, rngPic.Width, rngPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "\RangeImage\" & nameFile & ".jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set rngPic = Nothing
End Sub
  • Now, click on the Run ().

Copy Ranges From Multiple Worksheets and Paste as Images into Email Using VBA

Step 3:

  • If a window named Macro appears, just click on Run from that window.

click on Run

  • Finally, we will see that a window of the Outlook mail app appears with a new mail that has the ranges we have copied from the worksheet as separate jpg images in its body.

Range in New Mail

Read More: Macro to Send Email from Excel


Quick Notes

  • You should have the Outlook mail app to paste the range into the email body using VBA.
  • If you do not have a Developer tab, you can make it visible in File > Option > Customize Ribbon.
  • To open the VBA editor Press ALT + F11. You can press ALT + F8 to bring up the Macro window.

Download Practice Workbook

Download this practice book to exercise the task while you are reading this article.


Conclusion

In this article, we have learned how to use Excel VBA to paste range into the email body. I hope from now on you can use Excel VBA to paste range into the email body very easily. However, if you have any queries or recommendations about this article, please do leave a comment below. Have a great day!!!


Related Articles

What is ExcelDemy?

ExcelDemy - Learn Excel & Get Excel Solutions Center provides online Excel training , Excel consultancy services , free Excel tutorials, free support , and free Excel Templates for Excel professionals and businesses. Feel free to contact us with your Excel problems.
ASM Arman
ASM Arman

Abu Saleh Arman is a Marine engineer and Excel & VBA expert. He loves programming with VBA. He finds VBA programming a time-saving tool to manipulate data, handle files, and interact with the internet. He is very interested in Python, MATLAB, PHP, Deep Neural Networks, and Machine Learning, showcasing his diverse skill set. Arman holds a B.Sc in Naval Architecture & Marine Engineering from BUET, Bangladesh. However, he switched to a content developer, where he writes technical content... Read Full Bio

24 Comments
  1. Hello
    This is great!
    I have a question please bear with me, I am a beginner when it comes to VBA
    In my case I am looking to send a Pick up and delivery sheet (absolute range) daily.
    My workbook consists of a worksheet for every day of the month.
    Is there a way to have this module run by using a ActiveX button embedded in each days sheet to start instead of ALT F8 and run?

    Thank you for your help

    • Hello SHAWN,
      Thank you for letting us know your queries. Yes, there’s a way to attach a button to run your desired macro. Just insert any shape (Insert > Illustrations > Shapes) in the worksheet. Then, right-click on the shape to get the Context Menu. There, select the Assign Macro option. Hence, it’ll return a dialog box. Choose your desired macro and press OK. In this way, you don’t have to go to the VBA window to press the Run key.
      Hope you can perform the task. Please reach out to me at: [email protected] for further queries.
      Good luck.

  2. Hi ! Great code, works like a charm. But nevertheless I do have a request.
    I would very much like to have the number 3 method with a small adjustment.

    I have a set range on sheet1 (“A1:I30”) and a set range on sheet2 (“A1:I20”), these are always the same ranges.

    Can you adjust the method 3 code to send the two sheet ranges ??

    It would be appreciated very much 🙂

    Thanks for the help

    • Hello COEN,
      Thanks for reaching out to us. Regarding your issue, select the range A1:I30 of Sheet1 first. Then, go to Sheet2. Press the Ctrl key, and select the range A1:I20 simultaneously. Thus, you’ll have selected your desired ranges from both sheets. Now, follow the steps in method 3. In this way, you’ll have your required email body.
      Good luck.

  3. Really great code that saved me lots of time.
    Thanks alot.

  4. Hi, can i ask why the picture/body colours are missing in the email

    • Hello DARRYL,
      I’m not sure what you tried to mean by missing colors. The Headers are still blue in the email body. Please reach out to me at: [email protected] for any further queries. I’ll be happy to help.
      Good luck.

  5. Seems like method 2 missing createJpg() function from the screenshot above. Also, code for method 2 and 3 are still same as method 1 :p

    • Hello JKS,
      Thank you so much for pointing out the mistake. We’ve uploaded the accurate VBA codes in methods 2 & 3.
      And about your other issue regarding the screenshots, the codes are really long. That’s why we have demonstrated the upper portions only. But the entire code is there.
      Lastly, we are grateful for your feedback. It helps us to grow.
      Good luck.

  6. Hi I am using the code to copy pivot table range. But i am facing an issue with the copied cells. There is a chart also appearing on top of the copied cells. Not sure why this is happening.

  7. Hi,
    I’m trying to send one range on one email and then copy the code to send another range on a second email and so on – my aim is to send 20+ emails in one go each with a unique range copied on to it.
    What’s the best way to do this as when i try to duplicate the code multiple times, it only runs the first part.

    Thanks,
    Rowan

    • Hello, ROWAN!
      Check this article. This may help you.
      https://www.exceldemy.com/excel-automatically-send-email-when-condition-met/#2_Send_Email_Automatically_Based_on_a_Due_Date_Using_VBA_Code

      Use this code to send 20+ emails in one go each with a unique range. Just change the condition and range as per your requirements.

      Public Sub Send_Email_Automatically()
      Dim rngD, rngS, rngT As Range
      Dim ob1, ob2 As Object
      Dim LRow, x As Long
      Dim l, strbody, rSendValue, mSub As String
      On Error Resume Next
      Set rngD = Application.InputBox(“Deadline Range:”, “Exceldemy”, , , , , , 8)
      If rngD Is Nothing Then Exit Sub
      Set rngS = Application.InputBox(“Email Range:”, “Exceldemy”, , , , , , 8)
      If rngS Is Nothing Then Exit Sub
      Set rngT = Application.InputBox(“Email Topic Range:”, “Exceldemy”, , , , , , 8)
      If rngT Is Nothing Then Exit Sub
      LRow = rngD.Rows.Count
      Set rngD = rngD(1)
      Set rngS = rngS(1)
      Set rngT = rngT(1)
      Set ob1 = CreateObject(“Outlook.Application”)
      For x = 1 To LRow
      rngDValue = “”
      rngDValue = rngD.Offset(x – 1).Value
      If rngDValue <> “” Then
      If CDate(rngDValue) – Date <= 7 And CDate(rngDValue) - Date > 0 Then
      rngSValue = rngS.Offset(x – 1).Value
      mSub = rngT.Offset(x – 1).Value & ” on ” & rngDValue
      l = “


      strbody = “”
      strbody = strbody & “Hello! ” & rngSValue & l
      strbody = strbody & rngT.Offset(x – 1).Value & l
      strbody = strbody & “
      Set ob2 = ob1.CreateItem(0)
      With ob2
      .Subject = mSub
      .To = rSendValue
      .HTMLBody = strbody
      .Send
      End With
      Set ob2 = Nothing
      End If
      End If
      Next
      Set ob1 = Nothing
      End Sub

  8. Hey, thank you very much for the code, it’s fantastic!
    Just one question: is it possible to generate 2 screenshots (from 2 different ranges) from the same worksheet (methode 3) and if it’s possible what do I have to change within the code?
    Thank you in advance!
    Hannes

    • Hello, HANNES!
      You can use the same code to generate 2 screenshots (from 2 different ranges) from the same worksheet. All you have to do is, while selecting any range press Ctrl. Then, just Run the code.

      Or, you can use the code below, this will convert your excel file range to word document.

      Private Sub EmailSS(rng As Range, rng2 As Range, strName As String)
      ‘To Open Email
      Dim outlookApp As Outlook.Application
      Set outlookApp = CreateObject(“Outlook.Application”)
      Dim outMail As Outlook.MailItem
      Set outMail = outlookApp.CreateItem(olMailItem)
      With outMail
      .To = strName
      .Subject = “** Check this **”
      .Importance = olImportanceHigh
      .Display
      End With
      ‘To Get Word Document
      Dim wordDoc As Word.Document
      Set wordDoc = outMail.GetInspector.WordEditor
      ‘To Take Screenshot
      rng.Copy
      wordDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
      wordDoc.Content.InsertParagraphAfter
      rng2.Copy
      wordDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
      outMail.HTMLBody = “Timesheets Submitted by ” & strName & “
      ” & _
      Range(“Text”) & vbNewLine & outMail.HTMLBody
      End Sub

      Hope this will help you!
      Thanks for sharing your problem with use.

  9. Thank you, Sabrina! Unfortunately the method by pressing Crtl doesn’t work but the code below does its job 🙂 Thank you for that!

  10. If anybody needs it hereinafter please find my adapted code (big thank to Sabrina once again) for creating up to 5 screenshots within the same worksheet (from variable selections) and pasting them into a single mail:

    Private Sub EMailScreenshot()

    Dim strName As String
    Dim outlookApp As Outlook.Application
    Set outlookApp = CreateObject(“Outlook.Application”)
    Dim outMail As Outlook.MailItem

    Dim rngFirst As Range
    Dim rngSecond As Range
    Dim rngThird As Range
    Dim rngFourth As Range
    Dim rngFifth As Range

    On Error Resume Next

    Set rngFirst = Selection.Areas(1)
    Set rngSecond = Selection.Areas(2)
    Set rngThird = Selection.Areas(3)
    Set rngFourth = Selection.Areas(4)
    Set rngFifth = Selection.Areas(5)

    Set outMail = outlookApp.CreateItem(olMailItem)
    With outMail
    .To = ComboBox1.List(ComboBox1.ListIndex)
    .Subject = “”
    .Display
    End With

    Dim wordDoc As Word.Document
    Set wordDoc = outMail.GetInspector.WordEditor

    If Not rngFifth Is Nothing Then

    rngFirst.copy
    wordDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngSecond.copy
    wordDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngThird.copy
    wordDoc.Paragraphs(3).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngFourth.copy
    wordDoc.Paragraphs(4).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngFifth.copy
    wordDoc.Paragraphs(5).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    outMail.HTMLBody = outMail.HTMLBody

    Exit Sub

    End If

    If Not rngFourth Is Nothing Then

    rngFirst.copy
    wordDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngSecond.copy
    wordDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngThird.copy
    wordDoc.Paragraphs(3).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngFourth.copy
    wordDoc.Paragraphs(4).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    outMail.HTMLBody = outMail.HTMLBody

    Exit Sub

    End If

    If Not rngThird Is Nothing Then

    rngFirst.copy
    wordDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngSecond.copy
    wordDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngThird.copy
    wordDoc.Paragraphs(3).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    outMail.HTMLBody = outMail.HTMLBody

    Exit Sub

    End If

    If Not rngSecond Is Nothing Then

    rngFirst.copy
    wordDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    rngSecond.copy
    wordDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
    wordDoc.Content.InsertParagraphAfter
    outMail.HTMLBody = outMail.HTMLBody

    Exit Sub

    End If

  11. Hi,
    I need a help.
    I want to insert a (range) image in the center of the body mail.

    For example:
    I’ve inserted a image on Range”A1″,
    I want to paste a Range”A1″ in the center of the body mail.

    • Hello Asmitha, Thanks for your query. I found it very fascinating. Yes, we can insert a image in the A1 cell and export it to the Outlook in the middle of the email body.
      Put the following VBA code in the module and get the output like below image.
      Inserted a image in the middle of email body from Excel with VBA Macro

      
      Sub Insert_Image_Into_Excel_And_Send_Email()
          Dim imagePath As String
          imagePath = "E:\tanvir\Job\Softeko\Article\Exceldemy\Comment\1\a.png" ' Replace with your directory
      
          Dim ws As Worksheet
          Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with the name of your worksheet
      
          ' Insert the image into cell A1
          With ws.Shapes.AddPicture(imagePath, True, True, 0, 0, -1, -1)
              .Left = ws.Range("A1").Left
              .Top = ws.Range("A1").Top
              .Width = ws.Range("A1").Width
              .Height = ws.Range("A1").Height
          End With
      
          ' Send the email with the image attached
          Send_Email_With_Image_Attachment imagePath
      End Sub
      
      Sub Send_Email_With_Image_Attachment(imagePath As String)
          Dim OutlookApp As Object
          Dim OutlookMail As Object
          Dim HTMLBody As String
      
          ' Create a new instance of Outlook
          Set OutlookApp = CreateObject("Outlook.Application")
          Set OutlookMail = OutlookApp.CreateItem(0)
      
          ' Compose the email
          With OutlookMail
              .Subject = "Email with Image Attachment"
              .To = "[email protected]" ' Replace with the recipient's email address
              .CC = "[email protected]" ' Replace with CC email addresses (if needed)
              .HTMLBody = "Hi," & vbNewLine & vbNewLine & "This is an image attached from Excel:" & vbNewLine & vbNewLine & "<br><br>" & "<img src='" & imagePath & "'><br><br>" & _
                          "Regards," & vbNewLine & "Your Name"
      
              ' Attach the image to the email
              .Attachments.Add imagePath, olByValue, 0 ' olByValue is used to attach by value, not by reference
      
              ' Uncomment the next line if you want to send the email immediately (be careful)
              ' .Send
      
              ' Show the email draft for review before sending (comment this line if you want to send immediately)
              .Display
          End With
      End Sub
      

      Thanks a ton and have a good day.
      Regards,
      MD Tanvir Rahman
      Excel and VBA Content Developer
      Exceldemy, Softeko

  12. I have used the code and wanted to check if there is a code available to instead of sending it immediately, i would only need to copy a range of cells to copy as the email body input, then insert a file as attachment, and view it via Outlook mail app before hitting send button?

    • Reply Lutfor Rahman Shimanto
      Lutfor Rahman Shimanto Feb 22, 2024 at 6:32 PM

      Dear Khristine,

      Thank you for your comment. I have made some modifications to the code. Now, when you run it, a file picker dialog box will appear, allowing you to select a file. Once you’ve chosen the file, the Outlook app will open and a new email will be generated with the file attached. You can then manually send the email at your convenience. Here is the updated code:

      Sub Paste_Range_Outlook()
      
          Dim rng As Range
      
          Dim Outlook As Object
      
          Dim OutlookMail As Object
      
          Set rng = Nothing
      
          On Error Resume Next
      
          Set rng = Selection.SpecialCells(xlCellTypeVisible)
      
          On Error GoTo 0
      
          If rng Is Nothing Then
      
              MsgBox "Not a range or protected sheet" & _
      
                     vbNewLine & "please correct and try again.", vbOKOnly
      
              Exit Sub
      
          End If
      
          With Application
      
              .EnableEvents = False
      
              .ScreenUpdating = False
      
          End With
      
          ' Create a file dialog object
      
          Set FileDialog = Application.FileDialog(msoFileDialogFilePicker)
      
         
      
          ' Allow the user to select only one file
      
          FileDialog.AllowMultiSelect = False
      
         
      
          ' Display the file dialog box
      
          If FileDialog.Show = -1 Then
      
              ' User selected a file
      
              SelectedFile = FileDialog.SelectedItems(1)
      
          End If
      
          Set Outlook = CreateObject("Outlook.Application")
      
          Set OutlookMail = Outlook.CreateItem(0)
      
          On Error Resume Next
      
          With OutlookMail
      
              .To = ""
      
              .CC = ""
      
              .BCC = ""
      
              .Subject = "Excel Data you requested for"
      
              .HTMLBody = RangetoHTML(rng)
      
              .Attachments.Add SelectedFile
      
              .Display   'or use .Send
      
          End With
      
          On Error GoTo 0
      
          With Application
      
              .EnableEvents = True
      
              .ScreenUpdating = True
      
          End With
      
          Set OutlookMail = Nothing
      
          Set Outlook = Nothing
      
      End Sub
      
      Function RangetoHTML(rng As Range)
      
          Dim obj As Object
      
          Dim txtstr As Object
      
          Dim File As String
      
          Dim WB As Workbook
      
          File = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
      
          rng.Copy
      
          Set WB = Workbooks.Add(1)
      
          With WB.Sheets(1)
      
              .Cells(1).PasteSpecial Paste:=8
      
              .Cells(1).PasteSpecial xlPasteValues, , False, False
      
              .Cells(1).PasteSpecial xlPasteFormats, , False, False
      
              .Cells(1).Select
      
              Application.CutCopyMode = False
      
              On Error Resume Next
      
              .DrawingObjects.Visible = True
      
              .DrawingObjects.Delete
      
              On Error GoTo 0
      
          End With
      
          With WB.PublishObjects.Add( _
      
               SourceType:=xlSourceRange, _
      
               Filename:=File, _
      
               Sheet:=WB.Sheets(1).Name, _
      
               Source:=WB.Sheets(1).UsedRange.Address, _
      
               HtmlType:=xlHtmlStatic)
      
              .Publish (True)
      
          End With
      
          Set obj = CreateObject("Scripting.FileSystemObject")
      
          Set txtstr = obj.GetFile(File).OpenAsTextStream(1, -2)
      
          RangetoHTML = txtstr.readall
      
          txtstr.Close
      
          RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
      
                                "align=left x:publishsource=")
      
          WB.Close savechanges:=False
      
          Kill File
      
          Set txtstr = Nothing
      
          Set obj = Nothing
      
          Set WB = Nothing
      
      End Function

      I hope it will do the job for you.

      Regards
      Aniruddah Alam
      ExcelDemy

  13. Rather than stacking the multiple images down the body of the email, how can this code be adapted to attach the images next to each other, across the body of the email?

    • Reply Lutfor Rahman Shimanto
      Lutfor Rahman Shimanto Feb 11, 2024 at 4:47 PM

      Hello GRAHAM

      Thanks for reading our blogs and sharing your requirements. You wanted to display the range-converted images horizontally in the email body. This can be achieved by slightly modifying the article’s Excel VBA code.

      OUTPUT OVERVIEW:

      Excel VBA Code:

      
      Sub PasteMultipleRangeinMail()
          
          Dim FilePath As String
          Dim Outlook As Object
          Dim OutlookMail As Object
          Dim HTMLBody As String
          Dim rng As Range
          Dim Sheet As Worksheet
          Dim AcSheet As Worksheet
          Dim FileName As String
          Dim Src As String
          
          On Error Resume Next
          FilePath = Environ$("temp") & "\RangeImage\"
          
          If Len(VBA.Dir(FilePath, vbDirectory)) = False Then
            VBA.MkDir FilePath
          End If
          
          Set AcSheet = Application.ActiveSheet
          
          For Each Sheet In Application.Worksheets
              Sheet.Activate
              Set rng = Sheet.Application.Selection
              If rng.Cells.Count > 1 Then
                  Call createJpg(Sheet.Name, rng.Address, "DashboardFile" & VBA.Trim(VBA.Str(Sheet.Index)))
              End If
          Next
          
          AcSheet.Activate
          With Application
              .Calculation = xlManual
              .ScreenUpdating = False
              .EnableEvents = False
          End With
          
          Set Outlook = CreateObject("outlook.application")
          Set OutlookMail = Outlook.CreateItem(olMailItem)
          Src = ""
          
          FileName = Dir(FilePath & "*.*")
          Do While FileName <> ""
              Src = Src + "<img src='cid:" + FileName + "'>" ' Display images horizontally
              FileName = Dir
              If FileName = "" Then Exit Do
          Loop
          
          HTMLBody = "<span LANG=EN>" _
                      & "<p class=style1><span LANG=EN><font FACE=Times New Roman SIZE=4>" _
                      & "Dear GRAHAM," _
                      & "<br>" _
                      & "This is the Excel data you requested for:<br> " _
                      & "<br>" _
                      & Src _
                      & "<br><br>Best Regards</font></span>" _
                      & "<br>Lutfor Rahman Shimanto</font></span>" _
                      & "<br>Excel & VBA Developer</font></span>" _
                      & "<br>ExcelDemy</font></span>"
      
          With OutlookMail
              .Subject = "Displaying the Range-Converted Images horizontally in the Email Body"
              .HTMLBody = HTMLBody
              FileName = Dir(FilePath & "*.*")
              Do While FileName <> ""
                  .Attachments.Add FilePath & FileName, olByValue
                  FileName = Dir
                  If FileName = "" Then Exit Do
              Loop
              .To = "[email protected]"
              .CC = ""
             .Display
          End With
          
          If VBA.Dir(FilePath & "*.*") <> "" Then
              VBA.Kill FilePath & "*.*"
          End If
      
      End Sub
      
      Sub createJpg(SheetName As String, rngAddrss As String, nameFile As String)
          
          Dim rngPic As Range
          ThisWorkbook.Activate
          Worksheets(SheetName).Activate
          
          Set rngPic = ThisWorkbook.Worksheets(SheetName).Range(rngAddrss)
          rngPic.CopyPicture
          
          With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(rngPic.Left, rngPic.Top, rngPic.Width, rngPic.Height)
              .Activate
              .Chart.Paste
              .Chart.Export Environ$("temp") & "\RangeImage\" & nameFile & ".jpg", "JPG"
          End With
          
          Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
      
          Set rngPic = Nothing
      
      End Sub
      

      I have another present for you. If you ever want to attach the images generated from the selected ranges, you can use the following code:

      
      Sub AttachMultipleRangeAsImageInMail()
      
          Dim FilePath As String
          Dim Outlook As Object
          Dim OutlookMail As Object
          Dim rng As Range
          Dim Sheet As Worksheet
          Dim FileName As String
      
          On Error Resume Next
          FilePath = Environ$("temp") & "\RangeImage\"
      
          If Len(VBA.Dir(FilePath, vbDirectory)) = False Then
              VBA.MkDir FilePath
          End If
      
          For Each Sheet In Application.Worksheets
              Set rng = Sheet.UsedRange
      
              If Not rng Is Nothing Then
                  Call createJpg(Sheet.Name, rng, "DashboardFile" & VBA.Trim(VBA.Str(Sheet.Index)))
              End If
          Next
      
          Set Outlook = CreateObject("outlook.application")
          Set OutlookMail = Outlook.CreateItem(olMailItem)
      
          FileName = Dir(FilePath & "*.*")
          Do While FileName <> ""
              OutlookMail.Attachments.Add FilePath & FileName
              FileName = Dir
          Loop
      
          With OutlookMail
              .Subject = "Your Subject Here"
              .Body = "Dear Concerned," & vbCrLf & _
                      "This is the Excel data you requested for." & vbCrLf & vbCrLf & _
                      "Best Regards!"
              .To = "[email protected]"
              .Display
          End With
      
          If VBA.Dir(FilePath & "*.*") <> "" Then
              VBA.Kill FilePath & "*.*"
          End If
      
      End Sub
      
      Sub createJpg(SheetName As String, rng As Range, nameFile As String)
      
          Dim rngPic As Range
      
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = "TempSheet"
          Sheets("TempSheet").Activate
          rng.Copy
          ActiveSheet.Paste
          Set rngPic = ActiveSheet.UsedRange
      
          With ActiveSheet.ChartObjects.Add(rngPic.Left, rngPic.Top, rngPic.Width, rngPic.Height)
              .Chart.Paste
              .Chart.Export Environ$("temp") & "\RangeImage\" & nameFile & ".jpg", "JPG"
          End With
      
          Application.DisplayAlerts = False
          Sheets("TempSheet").Delete
          Application.DisplayAlerts = True
      
          Set rngPic = Nothing
      
      End Sub
      

      Hopefully, the codes will help in various situations. I have also attached the solution workbook; good luck.

      DOWNLOAD SOLUTION WORKBOOK

      Regards
      Lutfor Rahman Shimanto
      Excel & VBA Developer
      ExcelDemy

Leave a reply

Advanced Excel Exercises with Solutions PDF

 

 

ExcelDemy
Logo