回复 Outlook 文件夹中的特定电子邮件

Question

我正在尝试使用 VBA 在我的 Outlook 收件箱中搜索一个文件夹，并让它回复具有给定主题的最新电子邮件。到目前为止，我有以下代码：

Dim Fldr As Outlook.Folder
Dim olMail As Outlook.MailItem
Dim olReply As Outlook.MailItem
Dim olItems As Outlook.Items
Dim i As Integer
'Dim IsExecuted As Boolean
Set Fldr = Session.GetDefaultFolder(olFolderInbox).folders("Refund Correspondence")
'    IsExecuted = False
Set olItems = Fldr.Items
olItems.Sort "[Received]", True
For i = 1 To olItems.Count
    Set olMail = olItems(i)
    If InStr(olMail.subject, Me.Vendor_Client & " Tax Refund Request - " & Me.Vendor_Name) > 0 Then
        '            If Not IsExecuted Then
        If Not olMail.categories = "Executed" Then
            Set olReply = olMail.ReplyAll
            With olReply
                .BodyFormat = olFormatHTML       '''This is where I'm running into trouble 
                .Display
                .To = Me.Vendor_E_mail
                .subject = Me.Vendor_Client & " Tax Refund Request - " & Me.Vendor_Name
            End With
            Exit For
            olMail.categories = "Executed"
            '                IsExecuted = True
        End If
    End If
Next i

在我从事的其他项目中，我只需要从头开始创建一封电子邮件，并且我已经能够使用 Ron DeBruin 的 RangeToHTML(selection) 使用现有的电子邮件模板将指定范围粘贴到我的电子邮件中包含特定单词和替换功能以用表格替换单词。然而，对于这个项目，我想回复现有的电子邮件链。由于我无法参考电子邮件模板并用要插入的表格替换单词，所以我很茫然。 .bodyFormat = olFormatHTML 确实可以使用我的回复下方的链的其余部分来回复我想要的电子邮件，但我不知道之后如何将我想要的表格粘贴到电子邮件中。我尝试使用 .HTMLBody = rangetohtml(selection) 函数，但这只会创建一封新电子邮件，而链上没有以前的电子邮件。

Answer 1

如果 Word 用作电子邮件编辑器，则此方法有效。请尝试中间部分的以下代码。我假设您之前将指定范围复制到剪贴板中。

内部：

' needs a reference to the Microsoft Word x.x Object Library
With olReply
    .Display
    Dim wdDoc As Word.Document
    Set wdDoc = .GetInspector.WordEditor
    If Not wdDoc Is Nothing Then
        With wdDoc.Range
            .Collapse wdCollapseStart
            .InsertBefore "Hi," & vbCrLf & vbCrLf & _
                     "here comes my inserted table:" & vbCrLf
            .Collapse wdCollapseEnd
            .InsertAfter "Best wishes," & vbCrLf & _
                "..." & vbCrLf
            .Collapse wdCollapseStart
            .Paste
            '.PasteAndFormat wdChartPicture
            '.PasteAndFormat wdFormatPlainText
        End With
    End If
    Set wdDoc = Nothing
End With

如果您想知道在粘贴部分之前和之后插入文本的顺序：如果您通过.PasteAndFormat wdFormatPlainText 粘贴纯文本，则光标不会在文本之后移动。所以一个。米。在任何粘贴变体中，订单对我来说都很好。

如果您需要调试光标位置，只需在With wdDoc.Range 区域内添加一些.Select（仅用于调试目的）。

---

未来读者的“完整”示例：

Public Sub PasteExcelRangeToEmail()
    Dim objOL As Outlook.Application
    Dim NewEmail As Outlook.MailItem
    Dim wdDoc As Word.Document
    Dim wdRange As Word.Range

    ' get your Outlook object
    On Error Resume Next
    If objOL Is Nothing Then
        Set objOL = GetObject(, "Outlook.Application")
        If objOL Is Nothing Then
            Set objOL = New Outlook.Application
        End If
    End If
    On Error GoTo 0

    Set NewEmail = objOL.CreateItem(olMailItem)
    With NewEmail
        .To = "info@world"
        .Subject = "Concerning ..."
        .Display
        Set wdDoc = .GetInspector.WordEditor
        If Not wdDoc Is Nothing Then
            With wdDoc.Range
                .Collapse wdCollapseStart
                .InsertBefore "Hi there," & vbCrLf & "here's my table:" & vbCrLf
                .Collapse wdCollapseEnd
                .InsertAfter "Best wishes," & vbCrLf
                .Collapse wdCollapseStart
                ActiveSheet.Range("A1:C3").Copy
                .Paste
                '.PasteAndFormat wdChartPicture
                '.PasteAndFormat wdFormatPlainText
            End With
            Set wdDoc = Nothing
        End If
        '.Send
    End With
    Set NewEmail = Nothing
    Set objOL = Nothing
    Application.CutCopyMode = False
End Sub