2

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

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

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

这来自这里，以及：

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

从这里开始。

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

4

1 回答 1

4

我在RangetoHTML这里使用了 Ron 的功能。

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
于 2012-05-22T19:01:56.770 回答