CODEWITHSUNDEEP
excelvbaoutlook
Max Herring
Max Herring

Reputation: 61

Reply to specific email in Outlook folder

I'm trying to use VBA to search a folder in my Outlook inbox and have it reply to the most recent email with the given subject. So far I've got the following code:

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

In other projects I've worked on I've only needed to create an email from scratch, and I've been able to use Ron DeBruin's RangeToHTML(selection) to paste a specified range into my email using an existing email template containing specific words and the replace function to replace the words with tables. For this project, however, I want to reply to an existing email chain. Since I can't refer to an email template and replace a word with the table I want to insert, I'm at a loss. The .bodyFormat = olFormatHTML does work to reply to the email I want it to with the rest of the chain below my response, but I don't know how to paste the table I want into the email after that. I tried using the .HTMLBody = rangetohtml(selection) function, but that only created a new email without the previous emails on the chain.

Upvotes: 0

Views: 576

Answers (1)

Asger
Asger

Reputation: 3877

This works, if Word is used in as email editor. Please try following code in the middle part. I assume you copied the specified range before into clipboard.

Inner part:

' 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

If you wonder about the order of inserting text before and after the pasted part: If you paste plain text by .PasteAndFormat wdFormatPlainText the cursor is not moved after the text. So the a. m. order works fine for me in any paste variant.

If you need to debug the cursor position, just add some .Select within the With wdDoc.Range area (for debugging purposes only).

"Full" example for future readers:

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

Upvotes: 1

Related Questions