VBA/Macro Code for sending emails based on cell value. Please Help!!

[Jimbawbs]

Hi all,

I have created a spreadsheet that monitors qualification expiration dates for members of staff, and changes colour using conditional formatting, Green if Qual is current, orange when 30days to expiration and red when 7 days to expiration.

I want to set the spreadsheet to open up daily using windows, which i know how to do. However, when it opens i would like it to check the cell table for any dates which expire in 30days or less (orange) and if there are any, to alert me via email, then save and close itself.

Please help!!

Anxiously awaiting your responses

Many Thanks

James

PS. I have attempted this unsuccessfully myself via the method below:

Private Sub Workbook_Open()
If Range("C10:L27").Value = "<B34" Then
Application.Run "Mail_workbook_Outlook_1"
Else


End If
End Sub

which should use:

Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2013
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.to = "@.co.uk"
.CC = "@.co.uk"
.BCC = ""
.Subject = "Expiring Soon"
.Body = "Please Check the attached Training record for expiring qualifications"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[RCBricker]

is it running the sub at all on open and you are just looking for some way to get it to determine if there are any orange (or red I would assume) cells? or is the sub not running at all?

If it is not running at all (which I do not see any where that you are calling the sub)

then try...

Private Sub Workbook_Open()
 If Range("C10:L27").Value = " Application.Run "Mail_workbook_Outlook_1"
         call Mail_workbook_Outlook_1
 Else

 End If
 End Sub

if you need it to check if there is a colored cell then something like...

colorcount=0
for each cell in colorrange
     if not cell.interior.colorindex = -4142 then 
        colorcount=colorcount+1
     else
     end if
next cell

if not colorcount=0 then
     'here is where it will need to have the email code set
else
end if

something like that should get you on the right track

Rich