SENDING EMAIL WITH PASS/FAIL RESULT

Joined
May 10, 2012
Messages
6
Reaction score
0
Hello. I am still relatively new to using Macros in Excel and have been doing a lot of experimenting and researching, but am having difficulty getting the right code. When the test result is transferred from my Test Sheet to my Test Tracker sheet, it goes in column H3. The pass for the test is 60. So when the result is >59 I want "Passed" to be inserted in the J3 column. If the result is <60 then I want "Failed" to be inserted in the J3 column. Also, as soon as the test result and the Pass/Fail results are inserted, I have it programmed to send an email automatically for a pass or a fail. Right now I have to insert Passed or Failed into J3 manually before the test result is inserted, in order for the email to send out. I am using Excel 97-2003.

The codes are below.

This is in my Instructors worksheet of the Test Tracker Workbook

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("H3"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 59 Then
Call SendEmail
Else
If IsNumeric(Target.Value) And Target.Value < 60 Then
Call SendEmail
End If
End If
End If
End Sub

This in a Module of the Test Tracker Workbook

Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("I").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "passed" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "IST TEST RESULT"
.Body = "" & Cells(cell.Row, "B").Value _
& Cells(cell.Row, "C").Value _
& vbNewLine & vbNewLine & _
"You passed with " & _
Cells(cell.Row, "H").Value _
& "%" & _
vbNewLine & vbNewLine & _
"Your particulars will be added" & _
" to the Brigade IST Database."

'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "J").Value = "sent acceptance e-mail"
Set OutMail = Nothing


Else
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "failed" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "IST TEST RESULT"
.Body = "" & Cells(cell.Row, "B").Value _
& Cells(cell.Row, "C").Value _
& vbNewLine & vbNewLine & _
"Your test result was " & _
Cells(cell.Row, "H").Value _
& "%" & _
vbNewLine & vbNewLine & _
"You will need to do a re-test " & _
" Please let me know when you are ready for another test."
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "J").Value = "sent failed e-mail"
Set OutMail = Nothing


End If
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
 
Back
Top