Macro to email when a cell has certain value

Closed
rob - Mar 6, 2010 at 08:17 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Mar 8, 2010 at 11:19 AM
Hello,
I am using excel 2007 and I want to create a macro that runs automatically when the work book is loaded. the macro must check the value in cell (d53) and if that value is less than 0 then the macro needs to send an email notifying the recepiant of the value in (d53). once its done that I need it to go to sheet 2 in the workbook and carry out the same function but sending an email to a different receipiant but again sending the value in sheet 2 (d53) to the new recipiant. On top of this I need to be able to save this workbook so that users of older versions of excel can still use it. Can anyone help PPPLLLEEEAAASSSEEE
Related:

4 responses

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 6, 2010 at 09:05 AM
See this for creation of email from excel
https://ccm.net/forum/affich-107579-auto-notify-or-mail-when-excel-sheet-updated


As for running macro automatically, you can define the routine

sub auto_open()
<< your code here>>
end sub
2
Thanks for your reply.
I can get it to auto open and have performed certain tasks with auto open and then save and close but I dont know the code for the if function. I have the lines of code for the email but its the if function that I cant understand. any ideas.
thanks
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766 > rob
Mar 6, 2010 at 12:14 PM
Do some thing like this


sub auto_open()

    Dim vSheet1_D53 as variant
    Dim vSheet2_D53 as variant
    
    vSheet1_D53 = (0 + sheets("Sheet1").Range("d53"))
    
    vSheet2_D53 = (0 + sheets("Sheet2").Range("d53"))
    
    
    if (vSheet1_D53  < 0) then call sendEmail(1)
    
    if (vSheet2_D53 < 0) then call sendEmail(2)

end sub


Sub sendEmail(emailType as integer)

    If (emailType = 1) then 
    
        sendTo = "Person1@earth.com"
    
    elseif (emailType = 2) then
    
        sendTo = "Person2@earth.com"
    
    else
        exit sub
    end if
    
    <<... you email code ..>>
    
End sub



in case d53 has the email address then you can in auto open change d53 assignment as

vSheet1_D53 = "' & trim(sheets("Sheet1").Range("d53"))


and call the email routine as

if (vSheet1_D53 <> "") then call sendEmail(vSheet1_D53)


And change the sub routine sendEmail as


Sub sendEmail(sendTo as string)
0
rob > rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022
Mar 7, 2010 at 10:25 AM
Hi and thanks you so much, you are a genius.
I know I am pushing my luck but I wondered if you help me just once more. I am adding my workbook into my scheduled tasks so that it will open automatically at about 2am hence the openwork book part of the code. once its run the macro I need to save the workbook and auto close. any ideas?
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766 > rob
Mar 7, 2010 at 02:44 PM
The code you are making calls to send email, once the email are send out, add

activeworkbook.Save ' this will save the activeworkbook


application.Quit ' to close out excel completely
0
rob > rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022
Mar 7, 2010 at 05:21 PM
Thank you so much for your help so far.

i have copied and pasted your code but it doesnt seem to work. the macro doesnt run upon opening of the workbook. (d53) has a formula in it that counts entries in the range d2:d51 that have negative value in them (less than 0) what I need the macro to do is when the workbook is opened I need it to check cell d53 and if that value is greater than 0, I need it to send an email (the email address is not anywhere in the workbook) to a certain address informing the recipiant of the value in d53. I would like if its poss for the email to read. " you have ?? of overdue entries on the not posted list, please action immediatley." the ?? being the value shown in d53. I then need it to check the same cell on sheet 2 and perform the same action if the value in that cell is greater then 0, but sheet 2 and the info on that sheet would be sent to a different email address. once the 2 actions are done and any relevant emails are sent I would then like the book to save and close. Thank you so much for your help so far, I have been struggling with this for about 2 weeks and its been driving me crazy.
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 8, 2010 at 04:35 AM
dude

"<<... you email code ..>>" is exactly what I says

this was a place holder for email code. I was saying put the code here

What version of excel you have

See if u can use this method

activeworkbook.SendForReview(Recipients, Subject, ShowMessage, IncludeAttachment)
0
Hi
I have moved on and I can now get the workbook to open automatically using the scheduled tasks in system tools. when the workbook opens up it does send an email giving me the exact inforation that I want it to. it works perfect. this is the code I adapted.
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Sub Workbook_Open()
Call ThisWorkbook.SendEMail
End Sub

Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 4 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = "Your Annual Bonus"

' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that your annual bonus is "

Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A") ' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next r
End Sub

what I need it to do now is then run the same again but on sheet 2 (which is named "niel") and then automatically save and close.
could you help me with this last little bit. I could probably do it myself but it would take me another 2 weeks

Thanks
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 8, 2010 at 08:32 AM
Private Sub Workbook_Open()

    Dim toProcessSheets As Variant
    Dim thisSheet As Variant
    
    'name of sheets to process
    toProcessSheets = Array("Sheet1", "niel")
    
    For Each thisSheet In toProcessSheets

        Sheets(thisSheet).Select
        
        Call ThisWorkbook.SendEMail

    Next

End Sub 
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 8, 2010 at 08:50 AM
Rob see if this works

Private Sub Workbook_Open()

    Dim toProcessSheets As Variant
    Dim thisSheet As Variant
    
    'name of sheets to process
    toProcessSheets = Array("Sheet1", "niel")
    
    For Each thisSheet In toProcessSheets

        Sheets(thisSheet).Select
        
        Call ThisWorkbook.SendEMail

    Next

    'save the work book
    ActiveWorkbook.Save

    'close excel application
    Application.Quit
End Sub 
0
where about should I paste this code?
and also do you think there is way of only running the save and close part of the macro if the workbook is not modified for 1hr because in the day the users will all be opening the workbook to change certain values and if the save and close part runs straight away it will just close as soon as it opens. what do you think.

regards rob
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766 > rob
Mar 8, 2010 at 11:19 AM
A few things rob

This is a function or a sub routine that you mentioned earlier

Private Sub Workbook_Open()
     Call ThisWorkbook.SendEMail
End Sub



This routine is executed when the work book is open. It will send the emails out based on how the call is being made in SendMail routine.

I just modified that routines and included additional lines of code to process same email for all the sheets that you would indicate in this line toProcessSheets = Array("Sheet1", "niel")

So if the book is open and modified multiple times, it may send emails out (under right conditions).

It looks like saving the book and sending email are two different things. I thought that's what you wanted, but I guess I misunderstood you. Well I think it is possible to save and close the file, if not modified for an hour. right from the top of my head I think that you would need to use the event

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

End Sub

there needs to be a timer that sets for on hour or resets etc. Just need a little involved coding I guess.
0