Help needed with automated emailing of workbook

  • Thread starter Thread starter suek
  • Start date Start date
S

suek

Hello,

I thought I had solved a previous problem that I had with sending an email
when a value in a range got above a certain number, but I haven't as it seems
to send it out regardless.

I am trying to write the code to put in the workbook's beforeclose, but my
code is very rusty, and I am not sure of how to get it to work properly:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Declare variables

Dim shtSummary As Worksheet
Dim rngChange As Range
Set shtSummary = Application.Workbooks("xxx.xls").Worksheets("Summary")
Set rngChange = shtSummary.Range("M1:M12")
On Error GoTo EndMacro

If rngChange > 10 Then GoTo sendeMail


sendeMail:


'(with Thanks to Ron de Bruin)
Dim OutApp As Object
Dim OutMail As Object

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

On Error Resume Next
With OutMail
.To = "(me)"
.CC = ""
.BCC = ""
.Subject = "TEST TEST TEST"
.Body = "Site(s) in this contract appear over budget. Please verify
over costs are justified & appropriate documentation completed including
EOT,variations & additional works."
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing




EndMacro:

End Sub

Can someone help here please? Basically I am trying to say for each value
in the range, if the value is greater than 10 then send an email.
Thanks!
 
I just removed the go to statment and modified the IF statement.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Declare variables

Dim shtSummary As Worksheet
Dim rngChange As Range
Set shtSummary = Application.Workbooks("xxx.xls").Worksheets("Summary")
Set rngChange = shtSummary.Range("M1:M12")
On Error GoTo EndMacro

If rngChange > 10 Then GoTo



'(with Thanks to Ron de Bruin)
Dim OutApp As Object
Dim OutMail As Object

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

On Error Resume Next
With OutMail
.To = "(me)"
.CC = ""
.BCC = ""
.Subject = "TEST TEST TEST"
.Body = "Site(s) in this contract appear over budget. " & _
"Please verify over costs are justified & " & _
"appropriate documentation completed including " & _
"EOT,variations & additional works."
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
end if
End Sub
 
Hi,

Assuming that you wanted to keep the current code just add Exit Sub after:

If rngChange > 10 Then GoTo sendeMail

Exit Sub

sendeMail:
 
all you have to do is get rid of the goto.

from
If rngChange > 10 Then GoTo

to
If rngChange > 10 Then
 
No it's still not working. I have modified the code, to put the troublesome
percentages in red, and now it sends out the email every time I close the
workbook, not just when the percentage is higher than it should.

I keep finding reference to target.intersect when I lookup code, but I am
not sure how to use it, and cannot understand the help page, so I am not sure
if this would help or not. I want to send the email only once, regardless
of how many sites are over budget.

It looks like now:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Declare variables

Dim shtSummary As Worksheet
Dim rngChange As Range
Dim rngCell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrSite As String
On Error GoTo EndMacro

Set shtSummary = Application.Workbooks("xxx.xls").Worksheets("Summary")
Set rngChange = shtSummary.Range("M2:M12")


For Each rngCell In rngChange

If rngCell.Value > 10 Then

rngCell.Font.Color = vbRed

Else
rngCell.Font.Color = vbBlack
End If


Next rngCell



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

On Error Resume Next
With OutMail
.to = "(xxx)"
.CC = ""
.BCC = ""
.Subject = "xxx appear over budget"
.Body = "Site(s) in this contract appear over budget. Please verify
over costs are justified & appropriate documentation completed including
EOT,variations & additional works."
.Attachments.Add ActiveWorkbook.FullName
.Send


End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing




















EndMacro:


End Sub
 
Try these changes

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Declare variables

Dim shtSummary As Worksheet
Dim rngChange As Range
Dim rngCell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrSite As String
On Error GoTo EndMacro

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


Set shtSummary = Application.Workbooks("xxx.xls").Worksheets("Summary")
Set rngChange = shtSummary.Range("M2:M12")


For Each rngCell In rngChange

If rngCell.Value > 10 Then

rngCell.Font.Color = vbRed

On Error Resume Next
With OutMail
.to = "(xxx)"
.CC = ""
.BCC = ""
.Subject = "xxx appear over budget"
.Body = "Site(s) in this contract appear over budget. Please verify
over costs are justified & appropriate documentation completed
including
EOT,variations & additional works."
.Attachments.Add ActiveWorkbook.FullName
.Send

End With
On Error GoTo 0

Else
rngCell.Font.Color = vbBlack
End If
Next rngCell
EndMacro:
Set OutMail = Nothing
Set OutApp = Nothing

End Sub
 
Hello,

I thought this had worked, I sent it out this morning with this code, and
when people open and view it and then go to close it, it keeps sending it
out, and out and out....

Why is this so?
 
You never set the value back to 0 before sending out the e-mail. Try this
change


From:

If rngCell.Value > 10 Then


To: add new line just below if statement

If rngCell.Value > 10 Then
rngCell.Value = 0
 
Back
Top