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

それほど難しいことではないようで、何が起こっているのかについては合理的な考えがありますが、何を試してもうまくいきません。そのコードは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 

これは、ここから次のようになります。

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

ここから

興味のある範囲/テーブルの.jpgファイルを作成し、htmlを使用してそれらを電子メールの本文に入れるという考え方です。これらの2つのアプローチの間で、それを機能させることができるはずです。

4

1 に答える 1

4

ここではロンの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
于 2012-05-22T19:01:56.770 に答える