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

时间:2012-05-22 18:01:10

标签: vb.net excel com outlook

所以这是我之前提出的一个问题的更精炼版本。我一直试图解决这个问题。我找到了一个有意义的网站,但由于某些原因我无法实现它。我只是希望能够将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

似乎不应该那么困难,我对发生的事情有一个合理的认识,但无论我尝试什么都行不通。该代码在

上引发了一个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:\temp\SavedRange.jpg", Filtername:="JPG"

End Sub 

这来自here,以及:

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

来自here.

您的想法是创建您感兴趣的范围/表的.jpg文件,然后使用html将它们放在电子邮件的正文中。在这两种方法之间,你应该能够让它发挥作用。

1 个答案:

答案 0 :(得分:4)

尝试此操作(已完成测试

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