Monthly Archives: July 2005

NTBackupEmailStatus

This VB-script sends out status of your NTBackups to a specified e-mail address.
It should be scheduled to run every day since it checks the Windows Event Log for records created the same day where source is ntbackup. If the backup has failed or no ntbackup entries where found it sends an alert to an e-mail address that you specify in the script.

'=================================================================================================== 
'NTBackupEmailStatus.vbs
'
'Created by: Goran Tornqvist. 
'This script is freeware, do what you like with it ;)
' 
'Description: 
'This script sends out status of your NTBackups to a specified e-mail address.<br/>
'It should be scheduled to run every day since it checks the Windows Event Log for records created 
'the same day where source is ntbackup. 
'If the backup has failed or no ntbackup entries where found it sends an alert to an e-mail address
'that you specify in the script.
'===================================================================================================

'Constants used when sending the message
Const SMTP_SERVER = "smtp.yourisp.com"
Const SMTP_SERVER_PORT = 25
Const SMTP_FROM = "backup@yourdomain.com"
Const SMTP_TO = "you@yourdomain.com"

Const SeparatorString = "======================================"
blnSuccess = True

Sub MailMessage(blnStatus, strMessage)

	Set objMessage = CreateObject("CDO.Message")
	If blnStatus Then
		strStatus = "Success"
		'Do nothing - But you can choose to send an e-mail anyway to make sure the script is functioning.
		'Just put the code below the objMessage outside the "End If"
	Else
		strStatus = "Failure"

		objMessage.Subject = "NTBackup Daily Check (" & strStatus & ")"
		objMessage.From = SMTP_FROM
		objMessage.To = SMTP_TO
		objMessage.TextBody = strMessage

		objMessage.Configuration.Fields.Item _
		("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

		objMessage.Configuration.Fields.Item _
		("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER

		objMessage.Configuration.Fields.Item _
		("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_SERVER_PORT

		objMessage.Configuration.Fields.Update

		objMessage.Send
	End If

End Sub

Function customDateTime(str) 
	' deal with ugly date/time format of WMI 
	str = left(str,instr(str,".")-1): dt = left(str,8) 
	dt = left(dt,4) & "-" & left(right(dt,4),2) & "-" & right(dt,2) 
	tm = left(right(str,len(str)-8),4) 
	tm = left(tm,2) & ":" & right(tm,2) 
	customDateTime = dt & " " & formatdatetime(tm,3) 
End Function

Set loc = CreateObject("WbemScripting.SWbemLocator") 
Set nms = loc.ConnectServer() 

WQL = "SELECT " & _ 
	"TimeGenerated," & _ 
	"EventCode," & _ 
	"SourceName," & _ 
	"Message " & _ 
	"FROM Win32_NTLogEvent " & _ 
	"WHERE Logfile='Application'" 

On Error Resume Next
Set eventLog = nms.ExecQuery(WQL,"WQL",48) 

If err.number <> 0 Then
	On Error Goto 0
	blnSuccess = False
	str = "Error reading Application EventLog"
Else
	On Error Goto 0
	intCount = 0
	intCount2 = 0
	For Each logEvent In EventLog 

		eID = logevent.EventCode 
		msg = logEvent.message 
		src = logevent.sourcename 
		cdt = CDate(customDateTime(LogEvent.TimeGenerated))
		Today = CDate(Date & " 00:00:00")

		If src = "NTBackup" and cdt > Today Then
			If InStr(("x" & msg),"End Backup") > 0 OR InStr(("x" & msg),"End Operation") > 0 Then
				If InStr(("x" & msg),"successfully completed") = 0 AND blnSuccess Then
					blnSuccess = False
				End If
			End If

			str = str & SeparatorString & vbCrLf & _
				"DateTime: " & cdt & vbCrLf & _
				"Source: " & src & vbCrLf & _
				"EventId: " & eID & vbCrLf & _
				"Message: " & vbCrLf & msg & vbCrLf
			intCount2 = intCount2 + 1
		End If 

 		intCount = intCount + 1
		if intCount >= 1000 Then
			Exit For
		End If
        next

	If (intCount2 = 0) Then
		str = "No NTBackup entries found in the Application Event Log."
		blnSuccess = False
	Else
		str = str & SeparatorString & vbCrLf
	End If
End If

MailMessage blnSuccess, str