将excel中的值复制到outlook email vb.net正文中

所以这是我前面提到的问题的一个更加精细的版本。 我一直在试图解决这个问题。 我发现一个有意义的网站，但由于某种原因，我无法实现。 我只是想能够从Excel中复制信息（表格，图表，范围等）到Outlook电子邮件的正文中。

从这里： http : //pastebin.com/4VWmcrx6

它表明：

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 

我已经尝试了几个变种，但没有运气。

 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 

似乎不应该那么困难，而且对于发生的事情我有一个合理的想法，但不pipe我尝试什么都行不通。 这段代码会抛出一个comexception

 Doc = Application.ActiveInspector.WordEditor 

我也尝试使用代码，因为它给，但它说应用程序是不确定的。

任何帮助将不胜感激，一如既往的感谢。

对于后人（我在各地都能看到这个问题）：@Siddharth Rout的解决scheme肯定会起作用，但是如果你想让它在黑莓上不被截断（实际上它出现了，我发誓），更好的方法是在评论中find。

 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 

这来自这里 ，以及：

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

从这里。

这个想法是你创build你感兴趣的范围/表格的.jpg文件，然后使用html将它们放在电子邮件的正文中。 这两种方法之间，你应该能够得到它的工作。

Answer 1

试试这个（ TRIED AND TESTED ）

我在这里使用了Ron的RangetoHTML函数。

 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