Question

好的，所以我在这里有一点难题。这是我正在尝试的罗嗦版本：

在我已经在Outlook中创建的模板中，打开它并拖入一些文件 - 其中一个文件将是一个Excel文件。
打开Excel文件并读取预定的最后一个单元格
将单元格从最后一行/列复制到第一个单元格A1。
将先前在步骤3中复制的单元格粘贴到Outlook正文

目前我的问题所在。附件是代码

Const xlUp = -4162
'Needed to use the .End() method
 Sub Sample()
    Dim NewMail As MailItem, oInspector As Inspector
    Set oInspector = Application.ActiveInspector
    Dim eAttachment As Object, xlsAttachment As Object, i As Integer, lRow As Integer, lPriorRow As Integer, lCommentRow As Integer

    '~~> Get the current open item
    Set NewMail = oInspector.CurrentItem
    'Code given to me from a previous question

    Set eAttachment = CreateObject("Excel.Application")

    With NewMail.Attachments
        For i = 1 To .Count

            If InStr(.Item(i).FileName, ".xls") > 0 Then
                'Save the email attachment so we can open it
                sFileName = "C:/temp/" & .Item(i).FileName
                .Item(i).SaveAsFile sFileName

                eAttachment.Workbooks.Open sFileName

                With eAttachment.Workbooks(.Item(i).FileName).Sheets(1)

                    lCommentRow = .Cells.Find("Comments").Row
                    lPriorRow = .Cells.Find("Prior Inspections").Row

                    lRow = eAttachment.Max(lCommentRow, lPriorRow)
                    ' Weirdly enough, Outlook doesn't seem to have a Max function, so I used the Excel one.

                    .Range("A1:N" & lRow).Select
                    .Range("A1:N" & lRow).Copy

                    'Here is where I get lost; nothing I try seems to work

                    NewMail.Display

                End With


                eAttachment.Workbooks(.Item(i).FileName).Close

                Exit For

            End If

        Next
    End With

End Sub

我在另一个问题上看到了一个将Range对象更改为HTML的函数，但由于 此宏代码在Outlook中而不是Excel ，因此无法在此处使用。< / p>

任何帮助都将不胜感激。

Answer 1

也许this site会指出正确的方向。

编辑：

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

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 = "someone@organisation.com"
            .CC = "someoneelse@organisation.com"
            .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对象库。 This question指出了我的意思。我喜欢避免后期绑定，以便显示vba intellisense，我知道这些方法是有效的。

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

我还从this forum获得了有关如何将文本插入电子邮件正文的帮助。

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

我希望这会有所帮助。我确实学到了很多东西！

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

1 个答案:

编辑：

更多备注：