所以这是我之前提出的一个问题的更精炼版本。我一直试图解决这个问题。我找到了一个有意义的网站,但由于某些原因我无法实现它。我只是希望能够将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将它们放在电子邮件的正文中。在这两种方法之间,你应该能够让它发挥作用。
答案 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