View Single Post
 
Old 03-20-2015, 10:49 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,142
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

This is certainly something that can be done with a macro script and a rule to identify the message. Run the following script from a rule to identify the incoming messages. Change the values where indicated:

Code:
Option Explicit

Sub ConditionalReply(olItem As Outlook.MailItem)
Const strWorkBook As String = "WorkBookName.xlsx"        'The name of the attached workbook
Const strSheet As String = "Sheet1"        'The name of the worksheet to process
Const strCell As String = "B1"        'The cell to process
Const iCount As Integer = 20        'The threshold value of the above cell
Const strMessage As String = "This is the reply message body text." 'The default signature will be included.
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim lngCell As Long
Dim olAttach As Attachment
Dim bAttach As Boolean
Dim olInsp As Inspector
Dim olMail As MailItem
Dim wdDoc As Object
Dim oRng As Object
Dim bXStarted As Boolean
Dim fso As Object, TmpFolder As Object
Dim tmpPath As String

    bAttach = False
    For Each olAttach In olItem.Attachments
        If LCase(olAttach.Filename) = LCase(strWorkBook) Then
            Set fso = CreateObject("Scripting.FileSystemObject")
            tmpPath = fso.GetSpecialFolder(2)
            tmpPath = tmpPath & "\" & strWorkBook
            olAttach.SaveAsFile tmpPath
            bAttach = True
            Exit For
        End If
    Next olAttach
    If Not bAttach Then GoTo lbl_Exit
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo err_Handler
    Set xlWB = xlApp.Workbooks.Open(tmpPath)
    Set xlSheet = xlWB.Sheets(strSheet)
    lngCell = xlSheet.Range(strCell)
    If lngCell > iCount Then
        Set olMail = olItem.Reply
        With olMail
            .BodyFormat = olFormatHTML
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range(0, 0)
            .Display
            oRng.Text = strMessage
            '.Send 'Remove apostrophe after testing.
        End With
    End If
    xlWB.Close SaveChanges:=False
    Kill tmpPath
    If bXStarted Then
        xlApp.Quit
    End If
lbl_Exit:
    Set xlApp = Nothing
    Set xlWB = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    GoTo lbl_Exit
End Sub
You can test with an existing selected message using the following code:
Code:
Sub Test1()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    ConditionalReply olMsg
lbl_Exit:
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com

Last edited by gmayor; 03-21-2015 at 02:55 AM.
Reply With Quote