Ответить на конкретное письмо в папке Outlook - PullRequest
Новая
       6

Ответить на конкретное письмо в папке Outlook

0 голосов
/ 26 января 2019

Я пытаюсь использовать 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

В других проектах, над которыми я работал, мне нужно было только создать электронное письмо с нуля, и я смог использовать RangeToHTML (выбор) Рона Дебрюина, чтобы вставить указанный диапазон в мое письмо, используя существующий шаблон электронной почты. содержит конкретные слова и функцию замены, чтобы заменить слова таблицами. Однако для этого проекта я хочу ответить на существующую цепочку электронной почты. Поскольку я не могу сослаться на шаблон электронной почты и заменить слово таблицей, которую я хочу вставить, я в растерянности. .BodyFormat = olFormatHTML действительно работает, чтобы ответить на электронное письмо, которое я хочу, с остальной частью цепочки под моим ответом, но я не знаю, как вставить нужную таблицу в электронное письмо после этого. Я попытался использовать функцию .HTMLBody = rangetohtml (selection), но это только создало новое электронное письмо без предыдущих электронных писем в цепочке.

1 Ответ

0 голосов
/ 26 января 2019

Это работает, если 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 курсор не перемещается после текста.Таким образом, порядок am отлично работает для меня в любом варианте вставки.

Если вам нужно отладить позицию курсора, просто добавьте немного .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
...