使用Outlook VBA从Excel文件复制/粘贴。

也许这个网站会为您指明正确的方向。

编辑：

经过一番修补，我得到了这个工作：

Option Explicit

 Sub Sample()
    Dim MyOutlook As Object, MyMessage As Object

    Dim NewMail As MailItem, oInspector As Inspector

    Dim i As Integer

    Dim excelApp As Excel.Application, xlsAttachment As Attachment, wb As workBook, rng As Range

    Dim sFileName As String

    Dim lCommentRow As Long, lPriorRow As Long, lRow As Long

    ' Get the current open mail item
    Set oInspector = Application.ActiveInspector
    Set NewMail = oInspector.CurrentItem

    ' Get instance of Excel.Application
    Set excelApp = New Excel.Application

    ' Find the attachment
    For i = 1 To NewMail.Attachments.Count
        If InStr(NewMail.Attachments.Item(i).FileName, ".xls") > 0 Then
            MsgBox "Located attachment: """ & NewMail.Attachments.Item(i).FileName & """"
            Set xlsAttachment = NewMail.Attachments.Item(i)
            Exit For
        End If
    Next

    ' Continue only if attachment was found
    If Not IsNull(xlsAttachment) Then

        ' Set temp file location and use time stamp to allow multiple times with same file
        sFileName = "C:/temp/" & Int(CDbl(Now()) * 10000) & xlsAttachment.FileName
        xlsAttachment.SaveAsFile (sFileName)

        ' Open file so we can copy info
        Set wb = excelApp.Workbooks.Open(sFileName)

        ' Search worksheet for important info
        With wb.Sheets(1)        
            lCommentRow = .Cells.Find("Comments").Row
            lPriorRow = .Cells.Find("Prior Inspections").Row
            lRow = excelApp.Max(lCommentRow, lPriorRow)
            set rng = .Range("A1:H" & lRow)
        End With

        ' Set up the email message
        With NewMail
            .To = "[email protected]"
            .CC = "[email protected]"
            .Subject = "TEST - PLEASE IGNORE"
            .BodyFormat = olFormatHTML
            .HTMLBody = RangetoHTML(rng)
            .Display
        End With

    End If
    wb.Close

End Sub

Function RangetoHTML(rng As Range)
' By Ron de Bruin.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As workBook

    Dim excelApp As Excel.Application
    Set excelApp = New Excel.Application

    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
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8        ' Paste over column widths from the file
        .Cells(1).PasteSpecial xlPasteValues
        .Cells(1).PasteSpecial xlPasteFormats
        .Cells(1).Select
        excelApp.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:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set 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

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

您必须转到“工具”->“参考”并包括Microsoft Excel对象库。这个问题向我指出。我喜欢避免后期绑定，以便出现vba intellisense，并且我知道这些方法有效。

RangetoHTML来自Ron Debruin（我必须编辑PasteSpecial方法才能使它们工作）

我还从该论坛获得了一些有关如何将文本插入电子邮件正文的帮助。

我将日期添加到临时文件的名称，因为我试图多次保存它。

我希望这有帮助。我肯定学到了很多东西！

更多说明：

在我看来，这些细胞正在被截断。正如mvsub1在此说明的，使用RangeToHTML函数的问题在于它将超出列宽的文本视为隐藏文本，并将其粘贴到电子邮件中：

[td class=xl1522522 width=64 style="width:48pt"]This cell i[span style="display:none">s too long.[/span][/td]

如果您遇到类似的问题，页面上还会讨论一些解决方案。