View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
James James is offline
external usenet poster
 
Posts: 542
Default Send email based on cell value

Ron,

Genius!

A couple of modifications needed. Firstly can I add a pre-defined message
to the body of the email? Something like:

Joe,

These are the projects that have been over-allocated

The way you seem to do it is "Joe" & vbNewLine & vbNewLine & _ "..."

Also, what does this line do:

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

Finally, the code only generates the email, it doesn't send automatically.
What do I need to change?

Thanks for your help.
--
J


"Ron de Bruin" wrote:

Ok Try this one

Change this in the code

'Name of the worksheet with the data
Set WS = Sheets("Sheet1") '<<< Change

'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = WS.Range("A1:D" & Rows.Count)


Then set the filter field (B in your code i believe ?)

'This example filters on the second column in the range (change the field if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
rng.AutoFilter Field:=2, Criteria1:="<0"


It will display the mail first this example so you can view the mail first
Copy the macro and function below in a standard module in your excel workbook


Sub Test_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim WS As Worksheet

'Name of the worksheet with the data
Set WS = Sheets("Sheet1") '<<< Change

'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = WS.Range("A1:D" & Rows.Count)

'Firstly, remove the AutoFilter
WS.AutoFilterMode = False

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'This example filters on the second column in the range (change the field if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
rng.AutoFilter Field:=2, Criteria1:="<0"

Set rng = Nothing
On Error Resume Next
Set rng = WS.AutoFilter.Range
On Error GoTo 0

If rng Is Nothing Then GoTo EndMacro

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

On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0

EndMacro:

'Close AutoFilter
WS.AutoFilterMode = False

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function










--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"James" wrote in message ...
Ron,

Filtering would work and would probably be the easiest option.

As long as the macro filters the list, sends the range and then unfilters
the list at the end, it won't be a problem.

It would be great if you could set something up.

Thanks alot for your help.

James
--
J


"Ron de Bruin" wrote:

If I understand you correct?
Why not simple filter for negative values in the B column and send the visible data to the two Recipients

If this is what you want I wiil create a example for you


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message ...
Hi James

I read it and reply tomorrow after work

Bed time for me now


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"James" wrote in message ...
Ron,

Column A, cells 1-150 are project numbers that are entered by the user, i.e.
80163, 80176. They are not necessarily in a logical order, but will always
be 5 characters in length.

Column B, cells 1-150 will be a formula result that compares two other cell
values. Therefore man-days allowed MINUS man-days required to give the value
in the appropriate cell of column B (either positive or negative). If the
cell value is less than 0, the cell colour turns red. For arguments sake
man-days allowed would be column C and man-days required column D. The
man-days allowed figures (column C) will change very rarely. The man-days
required figures (column D) will change, therefore an email sent one week
might not need to be sent in three weeks time.

Recipients: Will always be the same two people, so they could be defined as
"jbloggs...." etc.

Sample data:

Column A Column B Column C
Column D
80163 -15 20
35
80176 15 35
20
80187 0 20
20
80190 -10 20
30

and so on...

Therefore the macro should send an email to two recipients (to be
specified), for project numbers 80163 and 80190 that say that they have too
many man-days allocated to them.

Subject header should include the project number to make it easy to know
where to amend the data.
The email message should include the figure in column B.

If in a fortnight, cell B1 (project number 80163) is positive, the macro
should re-send the email for project number 80190 (assuming B4 is still
negative).

Let me know if you still need info.

Thanks for the link. I have been looking at your example 2 on
http://www.rondebruin.nl/mail/change.htm
I am thinking a combination of the two might be the way to go??

--
J


"Ron de Bruin" wrote:

More info please about the info in the columns

Start here(see also example 2)
http://www.rondebruin.nl/mail/folder3/message.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"James" wrote in message ...
All,

I am looking for a macro that sends an email to two recipients based on the
cell values in a range. I have a table of 150 rows where a cell value can
fall below 0 (or conditional formatting turns it red), and for each row where
the value is less than 0 (or is red), send an email with a subject heading
which includes the row identification.

EG.

Cell A1: 80163
Cell B1: -15
Recipients: (to) Joe Bloggs ; (cc) Fred Bloggs

Email with the subject heading "80163 - Over allocation"
Message: "80163 has been over allocated by 15 man-days"

Repeat this for all rows, therefore if B2 is (positive) 15, an email is not
sent.

If changes were made to other calculations which resulted in B1 becoming
positive, I don't want the macro to loop through the entire list again and
re-send emails. I would prefer the this re-sending loop to occur every
fortnight on a Wednesday.

Hope this makes sense!