Copying values from excel to body of outlook email

Question

So this is a more refined version of a question I asked earlier. I have been trying to sort this out for quite a while. I found a site that makes sense, but I can't implement it for some reason. I just want to be able to copy information from excel (tables, charts, ranges, etc) into the body of an outlook email.

From here: http://pastebin.com/4VWmcrx6

It suggests:

Using VB.NET to copy Excel Range (a table) to body of Outlook email
Sub CopyFromExcelIntoEMail()
Dim Doc As Word.Document
Dim wdRn As Word.Range
Dim Xl As Excel.Application
Dim Ws As Excel.Worksheet
Dim xlRn As Excel.Range

Set Doc = Application.ActiveInspector.WordEditor
Set wdRn = Doc.Range

Set Xl = GetObject(, "Excel.Application")
Set Ws = Xl.Workbooks("Mappe1.xls").Worksheets(1)

Set xlRn = Ws.Range("b2", "c6")
xlRn.Copy

wdRn.Paste
End Sub

I have tried several variations of it, but with no luck.

Imports System.Data
Imports System.IO
Imports Microsoft.Office.Interop
Imports Office = Microsoft.Office.Core
Imports xlNS = Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Imports System.Net.Mail
Imports excel1 = Microsoft.Office.Interop.Excel
Imports word1 = Microsoft.Office.Interop.Word
Imports outlook1 = Microsoft.Office.Interop.Outlook

Module Module1

    Sub Main()
        Dim Doc As Word.Document
        Dim wdRn As Word.Range
        Dim Xl As Excel.Application
        Dim Ws As Excel.Worksheet
        Dim xlRn As Excel.Range

        Dim application As New Outlook.Application
        Dim mail As Outlook.MailItem = CType(application.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)


        Doc = Application.ActiveInspector.WordEditor
        wdRn = Doc.Range

        Xl = GetObject("C:\Users\ajohnson\Desktop\Book1.xlsx", "Excel.Application")
        Ws = Xl.Workbooks("Book1").Worksheets(1)

        xlRn = Ws.Range("a1", "d2")
        xlRn.Copy()

        With mail
            .Body = wdRn.Paste() & vbCr & wdRn.Paste()

        End With

    End Sub

End Module

It doesn't seem like it should be that difficult and I have a reasonable idea of what is going on, but no matter what I try it does not work. That code throws a com exception on

Doc = Application.ActiveInspector.WordEditor

I also tried using the code as it was give, but it says application is undefined.

Any help would be greatly appreciated, Thank you as always.

For posterity (I see this question all over the place): The solution from @Siddharth Rout will definitely work, but if you are trying to make it not get truncated on blackberries (it actually comes up, I swear) a better approach can be found in the comments.

Sub Export_Range_Images()

' =========================================
' Code to save selected Excel Range as Image
' =========================================

Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture
Set oRange = Range("A1:B2")
Set oCht = Charts.Add
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste

oCht.Export FileName:="C:\temp\SavedRange.jpg", Filtername:="JPG"

End Sub 

This comes from here, along with:

.HTMLBody="< img src='C:\Temp\logo.jpg'>" & vbCr & "< img src='C:\Temp\logo.jpg'>"

From here.

The idea being that you create .jpg files of the ranges/tables you are interested in and then use html to put them in the body of the email. Between these two approaches you should be able to get it working.

Answer 1

Try this (TRIED AND TESTED)

I have used Ron's RangetoHTML function here.

Imports Excel = Microsoft.Office.Interop.Excel
Imports Olook = Microsoft.Office.Interop.Outlook

Public Class Form1
    '~~> Define your Excel Objects
    Dim xlApp As New Excel.Application
    Dim xlWorkBook As Excel.Workbook
    Dim xlWorkSheet As Excel.Worksheet
    Dim xlRange As Excel.Range

    '~~> Define Outlook Objects
    Dim olApp As New Olook.Application
    Dim olMail As Olook.MailItem

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        '~~> Opens an exisiting Workbook. Change path and filename as applicable
        xlWorkBook = xlApp.Workbooks.Open("C:\Sample.xlsx")
        '~~> Set the relevant sheet that we want to work with
        xlWorkSheet = xlWorkBook.Sheets("Sheet1")

        xlRange = xlWorkSheet.Range("A1:F20")

        olMail = olApp.CreateItem(0)

        On Error Resume Next
        With olMail
            .To = "INSERT TO EMAIL HERE"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .HTMLBody = RangetoHTML(xlRange)
            .Display()   'or use .Send to send it
        End With
        On Error GoTo 0

        '~~> Close the File
        xlWorkBook.Close (False)

        '~~> Quit the Excel Application
        xlApp.Quit()

        '~~> Clean Up
        releaseObject (xlApp)
        releaseObject (xlWorkBook)

        '~~> Similarly cleanup for outlook. not including as I am using .Display()

    End Sub

    Function RangetoHTML(rng As Excel.Range)
        ' Changed by Ron de Bruin 28-Oct-2006
        ' Working in Office 2000-2010
        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Excel.Workbook

        TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

        'Copy the range and create a new workbook to past the data in
        rng.Copy()

        TempWB = xlApp.Workbooks.Add(1)

        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial(Paste:=8)
            .Cells(1).PasteSpecial(-4163, , False, False)
            .Cells(1).PasteSpecial(-4122, , False, False)
            .Cells(1).Select()
            xlApp.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete()
            On Error GoTo 0
        End With

        'Publish the sheet to a htm file
        With TempWB.PublishObjects.Add( _
             SourceType:=4, _
             Filename:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
             HtmlType:=0)
            .Publish (True)
        End With

        'Read all data from the htm file into RangetoHTML
        fso = CreateObject("Scripting.FileSystemObject")
        ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.ReadAll
        ts.Close()
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")

        'Close TempWB
        TempWB.Close(savechanges:=False)

        'Delete the htm file we used in this function
        Kill (TempFile)

        ts = Nothing
        fso = Nothing
        TempWB = Nothing
    End Function

    '~~> Release the objects
    Private Sub releaseObject(ByVal obj As Object)
        Try
            System.Runtime.InteropServices.Marshal.ReleaseComObject (obj)
            obj = Nothing
        Catch ex As Exception
            obj = Nothing
        Finally
            GC.Collect()
        End Try
    End Sub
End Class