Outlook macro to check a value of a cell in an attachment and send an email based on that value

[ketangarg86]

Hi,

I am very new to Outlook macros and was thinking to automate and better manage my mails. Could you please help me out.

1. I want to write a macro that reads the value of a cell in the excel attachment of a mail. The mail is standardised and so the attachment name and the subject of the mail will remain the same.
2. After reading and checking the value of that predefined cell, I want to send an email to more people only if the value of that cell is greater than 20, for example.
3. Is there a way the macro kicks in automatically when such email comes.

Other than that, is there any other way apart from a macro that I can achieve my goal.

Thanks again and I really appreciate your help.

Thanks


Ketan

[gmayor]

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:

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:

Sub Test1()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    ConditionalReply olMsg
lbl_Exit:
    Exit Sub
End Sub

[ketangarg86]

Thanks dude. I tried the code but nothing happens when I run the macro. Not sure what I am doing wrong.

Also, how to add the email address of people to whom the mail should be going to in case the value in the excel cell is greater than 20.

[gmayor]

Did you change the values (repeated below) to reflect what you have? You said that the workbook attachment always has the same name, so put that name where shown below. The other values reflect values I cannot know without seeing the workbook, so change those as required.


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 message created was a reply to the message received with the attachment, so the recipient will be the sender of that message. I take it that you want to send it on to others rather than reply? If that is the case, change the lines

Set olMail = olItem.Reply
With olMail

to

Set olMail = olItem.Forward
With olMail
.To = "someone@somewhere.com; someoneelse@somewhereelse.com"

where the recipients are the addresses in bold, separated by semi-colons.

[ketangarg86]

Thanks for your prompt response. Yes, I did change the values you asked me to do. I have attached the sample excel sheet and the code below.

Const strWorkBook As String = "Count0To12Hr.xls" 'The name of the attached workbook
Const strSheet As String = "Count0To12Hr" 'The name of the worksheet to process
Const strCell As String = "E2" 'The cell to process
Const iCount As Integer = 25 'The threshold value of the above cell
Const strMessage As String = "count for today dropped by 20 percent from last weekday"

[gmayor]

The macro triggers a message when the value in the worksheet is greater than the value of iCount. You have iCount at 25, whereas the worksheet cell E2 has a value of 20 (so as 20 is less than 25, there will be no message). Change the value of iCount to less than the value of E2 if you want a message.

[ketangarg86]

This is working like a gem. Thanks a zillion for your help

On another note, one more thing,

Is there a way that I can copy the contents of a worksheet from the excel attachment and send that in a body of an email. Again, here also, the email coming would have a predefined subject with predefined attachment name.

The reason for this, many people would be reluctant to open the attachment so it is easier that the contents of excel are in the body of the mail.

[gmayor]

I take it you mean the same e-mail we have created? In that case locate the line

Set xlSheet = xlWB.Sheets(strSheet)

and add the line

xlSheet.UsedRange.Copy

immediately after that line

Then locate the line

oRng.Text = strMessage

and change that to

oRng.Text = strMessage & vbCr & vbCr
            oRng.collapse 0
            oRng.Paste
            With oRng.Tables(1)
                'Include any table formatting here e.g.
                .Style = "Table Grid"
            End With

[ketangarg86]

Thanks dude.

I was running the macro we created yesterday and two things happen,

1. There is an excel file open once the macro is run. I don't want to keep an open excel.
2. I get the below error, though the excel file results looks good, once the script is run. The numbers in the excel cell are in millions but the percent decrease is only -10. Is it because the number is negative. BUt again the other script when the number was -0.2 worked fine.

9
Subscript out of range

[gmayor]

The macro should only leave Excel open if it was open before running the process.
The subscript out of range error suggests that VBA has crashed irrecoverably (in which case you need to reboot) or the criteria set at the top of the macro to match your data i.e.

Const strWorkBook As String = "Count0To12Hr.xls"        'The name of the attached workbook
Const strSheet As String = "Count0To12Hr"        'The name of the worksheet to process
Const strCell As String = "E2"        'The cell to process
Const iCount As Integer = 19        'The threshold value of the above cell
Const strMessage As String = "This is the reply message body text." 'The default signature will be included.

What is the range of values that could appear in E2?
What is the range of values that you might put in iCount?
Look up the numeric ranges for Integer and Long variables.

It might be better to change

Const iCount As Integer = 19
to
Const iCount As Long = 19

[ketangarg86]

I have two reports running Count0To12Hr and Count12To24Hr both we the similar macros. Count0To12Hr works fine but Count12To24Hr still gives the same error - Subscript out of error.

What is the range of values that could appear in E2? -100 to 100
What is the range of values that you might put in iCount? -100 to 100

Now, I tried the scenario where iCount is -15 and the cell value is -10. It gives me an error at the below
olAttach.SaveAsFile tmpPath

Could you please advise.

[ketangarg86]

Could it be the case that in my excel sheet the cell value is formatted as big decimal and in my outlook vba I am using long/integer. Unfortunately, I cannot change the excel attachment format.

Could this be the reason for subscript out of range error and macro not running properly.

If the excel cell value = -0.2 and iCount value as -15 (this works fine)
If the excel cell value = -10.2 and iCount value as -15 (this gives subscript error)

[gmayor]

The Excel format is not the problem What are important are these three values, which must match the Excel file being processed.

Const strCell As String = "E2"
Const strWorkBook As String = "Count0To12Hr.xls"
Const strSheet As String = "Count0To12Hr"

Also change

lngCell = xlSheet.Range(strCell)

to

lngCell = Val(xlSheet.Range(strCell))

which should resolve the issue with negative values.

While testing make the Excel app visible so that if it does crash you are not left with a hidden Excel application.

xlApp.Visible = True

[ketangarg86]

Now everything works as expected. Thanks a zillion Mr. Mayor

REALLY APPRECIATE your help.