Event List monitor

Dim dtmStart, SearchEventStart
Dim objWMIService, colEvents, objEvent, EventTime
Dim objMessage, eventCounted
Dim ObjSendMail
Set WshNetwork = CreateObject("WScript.Network")
Set ObjSendMail = CreateObject("CDO.Message") 
Const MinutesToSearchWithin = -2 ' look for the event that triggered me within the last 2 minutes
Set dtmStart = CreateObject("WbemScripting.SWbemDateTime")
SearchEventStart = DateAdd("n", MinutesToSearchWithin, Now())
dtmStart.SetVarDate SearchEventStart, True
 
txt = ""
 
strComputer = WshNetwork.ComputerName
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery ("Select * from Win32_NTLogEvent Where Type = 'error' And Logfile = 'Application' And TimeWritten >= '" & dtmStart & "'") 
For Each objEvent in colLoggedEvents
txt = txt &  "Category: " & objEvent.Category
EventTime = Mid(objEvent.TimeWritten, 5, 2) & "/" & Mid(objEvent.TimeWritten, 7, 2) & "/" & _
    Mid(objEvent.TimeWritten, 1, 4) & " " & Mid(objEvent.TimeWritten, 9, 2) & ":" & _
    Mid(objEvent.TimeWritten, 11, 2) & "." & Mid(objEvent.TimeWritten, 13, 2)
txt = txt &  vbCrLf & "Time: " & EventTime
txt = txt &  vbCrLf & "EventCode: " & objEvent.EventCode
txt = txt &  vbCrLf & "Message: " & objEvent.Message
txt = txt &  vbCrLf & "RecordNumber: " & objEvent.RecordNumber
txt = txt &  vbCrLf & "SourceName: " & objEvent.SourceName
txt = txt &  vbCrLf & "Type: " & objEvent.Type
txt = txt &  vbCrLf & "User: " & objEvent.User
txt = txt &  vbCRLF & objEvent.Message & "http://eventid.net/display.asp?eventid=" &objEvent.EventCode & "&source=" & objEvent.SourceName & vbcrlf & vbcrlf & vbcrlf
Next
 
 
if txt <> "" then
 
txt = "The Following Application Errors Have Occurred on : " & strComputer & vbcrlf & vbCRLF & txt 
 
else
Wscript.Quit(0)
end if
     
'This section provides the configuration information for the remote SMTP server.
     
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mail.yourserver.com"
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 'Use SSL for the connection (True or False)
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
     
' If your server requires outgoing authentication uncomment the lines bleow and use a valid email address and password.
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") ="your@email.com"
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="password"
     
ObjSendMail.Configuration.Fields.Update
     
'End remote SMTP server configuration section==
     
ObjSendMail.To = "your@email.com"
ObjSendMail.Subject = strComputer & "  Has encountered Application Errors"
ObjSendMail.From = strComputer & "@email.com"
     
' we are sending a text email.. simply switch the comments around to send an html email instead
'ObjSendMail.HTMLBody = "this is the body"
ObjSendMail.TextBody = strComputer & chr(32) & txt
     
ObjSendMail.Send
     
Set ObjSendMail = Nothing 
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68: