Reputation: 1057
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.
Upvotes: 2
Views: 16343
Reputation: 149325
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
Upvotes: 4