将值从 excel 复制到 Outlook 电子邮件 vb.net 的正文

Question

所以这是我之前问的一个问题的更精致的版本。我一直在尝试解决这个问题很长一段时间。我找到了一个有意义的网站，但由于某种原因我无法实现它。我只是希望能够将信息从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:UsersajohnsonDesktopBook1.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

这似乎不应该那么困难，我对正在发生的事情有一个合理的想法，但无论我尝试什么都不起作用。该代码引发 com 异常

Doc = Application.ActiveInspector.WordEditor

我也尝试使用给定的代码，但它说应用程序未定义。

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

对于后代(我到处都看到这个问题(：@Siddharth Rout 的解决方案肯定会奏效，但如果你想让它不被黑莓截断(它实际上出现了，我发誓(，可以在评论中找到更好的方法。

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:tempSavedRange.jpg", Filtername:="JPG"
End Sub 

这来自这里，以及：

.HTMLBody="< img src='C:Templogo.jpg'>" & vbCr & "< img src='C:Templogo.jpg'>"

从这里。

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

Answer 1

我在这里使用了 Ron's 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