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）将指定范围粘贴到我的电子邮件中包含特定的单词和replace函数，以用表格替换单词。但是，对于这个项目，我想回复一个现有的电子邮件链。由于我无法引用电子邮件模板，而无法用要插入的表格替换单词，所以我很茫然。 .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粘贴纯文本，则光标不会在文本之后移动。所以。米订单对我来说在任何粘贴变体中都很好。

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

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

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

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

1 个答案: