Wednesday, June 17, 2009

VBScript to Check Server Health

This script creates a mini-report of server health. At my current company, we are required to send a report twice per day of critical systems. For the first couple of weeks I did this report by hand, but after a couple of times doing that I had to script it.

The script loops through a list of servers in a text file, gathers disk space and critical service state, writes the info to an Excel sheet, and then sends the sheet via email.


Some specifics:

  1. The script loops through all drives. If the drive (such as A:) has no size, the drive letter is added with no value.
  2. The services are predetermined. For example, if a server is an Exchange server, the script looks for the relevant Exchange services to ensure that they are running and prints their state to the sheet.
  3. There is a condition, if the disk space is less than 10% free and/or any of the critical services are stopped, the message is sent only to the engineer (me) as an important message. If everything is OK the sheet is sent out to the appropriate recipients (my boss and team).
  4. The worksheet is automatically deleted after the message is sent.
Making the script work:

  1. strEngineer - this is the person running the script
  2. strDirectory - this is the directory where the script and list of servers lives
  3. strFileName - the name of the excel sheet used for writing and attaching to the message
  4. SendAttach() - this sub contains a conditional statement with the email address of the recipient when all conditions are OK. This address needs to be changed to whomever receives the report.


'***************************************************************
'Server Check script
'Created By: Brian Bohanon
'-This script reads in a list of servers from a text file and
'-queries each server using WMI for hard disk space and service
'-status.
'***Customizations****
'strEngineer = Email address of engineer running script
'strDirectory = Directory of server list and script
'srcFileName = name of file containing list of servers
'strLocation = office location
'***************************************************************

'Global variable to determine who to mail the report to
Dim strMailFlag, strEngineer, strDirectory, strFileName

'Change to the address of the engineer running the script
strEngineer = "engineer@myjob.com"
'Change to the directory where the script and server list live
strDirectory = "C:\ServerChecks\"
'Change to the appropriate location
strLocation = "My Office"
'Excel file name
strFileName = strDirectory & strLocation & "_Server_Checks_" & Month(Date()) & "_" & Day(Date()) & "_" & Year(Date()) & " " & Right(Time(),2) & ".xls"
'Change this variable to another location if needed
srcFileName = "servers.txt"

CreateWorkbook()
SendAttach()
DeleteFile()
MsgBox "Complete"

Sub CreateWorkbook()

   Dim disk_size, disk_free
   Dim m,n
   Set objExcel = CreateObject("Excel.Application")
   Set objWorkbook = objExcel.Workbooks.Add()

   n = 1
   m = 1

   'Column headers
   objExcel.Cells(m, n) = "Server Name"
   objExcel.Cells(m, n).Font.Bold = True
   n = n + 1
   objExcel.Cells(m, n) = "Free Space"
   objExcel.Cells(m, n).Font.Bold = True
   n = n + 1
   objExcel.Cells(m, n) = "Services"
   objExcel.Cells(m, n).Font.Bold = True
   n = n + 1

   'Open File of server names -------------------------------------
   i = 0
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   'Open the text file for reading
   Set objFile = objFSO.OpenTextFile(srcFileName, 1)
   Do Until objFile.AtEndOfStream
    Redim Preserve arrFileLines(i)
    arrFileLines(i) = objFile.ReadLine
    i = i + 1
   Loop

   objFile.Close
   '---------------------------------------------------------------
   n = 1
   m = 3
   'For each server name get info and put into worksheet
   For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
    'set computer to the current index in the array
    strComputer = arrFileLines(l)
    'connect to the computer's WMI service
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
     If Err <> 0 Then
      DisplayErrorInfo()
      objExcel.Quit
     End If

    objExcel.Cells(m, n) = strComputer
    objExcel.Cells(m, n).Font.Bold = True
    j = m
    m = m + 1
    '-----------------------------------------------------------
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk")
    Set colServices = objWMIService.ExecQuery("Select * From Win32_Service")

    For each objDisk in colDisks
     objExcel.Cells(m, n) = objDisk.DeviceID
     n = n + 1
     'Convert into GB
     If objDisk.Size > 0 Then
      disk_size = objDisk.Size / 1073741824
      disk_free = objDisk.FreeSpace / 1073741824
      If disk_free > 0 Then
       strPercent = Round((int(disk_free)/int(disk_size)*100),2)
       'Check the percentage of the disk free space - if less than 10% free, only mail to engineer, not team
        If strPercent < 10 Then          strMailFlag = 0         Else          strMailFlag = 1         End If       Else         strMailFlag = 0       End If       'Write to Excel       objExcel.Cells(m, n) = "Total: " & int(disk_size) & "GB" & " Free: " & int(disk_free) & "GB" & " (" & strPercent & "%)"      End If      'Move to next cell      n = 1      m = m + 1     Next     'Check the status of predetermined services-------------------     'New services can be added based on the service name     For Each objService in colServices      If InStr(objService.Name, "MSExchangeIS") Then       objExcel.Cells(j, 3) = objService.Name       objExcel.Cells(j, 4) = objService.State       If objService.State = "Stopped" Then        strmailflag = 0       End if       j = j + 1      ElseIf InStr(objService.Name, "MSExchangeMGMT") Then       objExcel.Cells(j, 3) = objService.Name       objExcel.Cells(j, 4) = objService.State       If objService.State = "Stopped" Then        strmailflag = 0       End if       j = j + 1      ElseIf InStr(objService.Name, "MSExchangeMTA") Then       objExcel.Cells(j, 3) = objService.Name       objExcel.Cells(j, 4) = objService.State       If objService.State = "Stopped" Then        strmailflag = 0       End if       j = j + 1      ElseIf InStr(objService.Name, "MSExchangeSA") Then       objExcel.Cells(j, 3) = objService.Name       objExcel.Cells(j, 4) = objService.State       If objService.State = "Stopped" Then        strmailflag = 0       End if       j = j + 1      ElseIf InStr(objService.Name, "IISADMIN") Then       objExcel.Cells(j, 3) = objService.Name       objExcel.Cells(j, 4) = objService.State       If objService.State = "Stopped" Then        strmailflag = 0       End if       j = j + 1      ElseIf InStr(objService.Name, "W3SVC") Then       objExcel.Cells(j, 3) = objService.Name       objExcel.Cells(j, 4) = objService.State       If objService.State = "Stopped" Then        strmailflag = 0       End if       j = j + 1      End If     Next     Set objService = Nothing     Set objDisk = Nothing     m = m + 3    Next    '--------------------------------------------------------------    ' Autofit the first column to fit the longest service name    objExcel.Columns("A:Z").EntireColumn.AutoFit    'Delete remaining worksheets    objExcel.Worksheets("Sheet2").Delete    objExcel.Worksheets("Sheet3").Delete    'Save    objWorkbook.SaveAs strDirectory & strLocation & "_Server_Checks_" & Month(Date()) & "_" & Day(Date()) & "_" & Year(Date()) & " " & Right(Time(),2) & ".xls", 56    'Close Excel    objExcel.Quit    Set objExcel = Nothing    Set objFSO = Nothing    Set objWMIService = Nothing End Sub 'Create a mail message and send it via Outlook sub SendAttach()    'Open mail, adress, attach report    Dim objOutlk    Dim objMail    Dim strMsg    Const olMailItem = 0    'Create a new message     Set objOutlk = createobject("Outlook.Application")     Set objMail = objOutlk.createitem(olMailItem)     If strMailFlag = 0 Then      objMail.To = strEngineer      objMail.Importance = 2     Else      objMail.To = "boss@myjob.com"      objMail.cc = "myteam@myjob.com" 'Enter an address here To include a carbon copy; bcc is For blind carbon copy's      'objMail.bcc = ""     End if    'Set up Subject Line    objMail.subject = "Server Check " & strLocation & " " & Month(Date()) & "_" & Day(Date()) & "_" & Year(Date()) & " " & Right(Time(),2)    objMail.attachments.add(strFileName)    objMail.Send    'Clean up    Set objMail = nothing    Set objOutlk = nothing end sub 'Delete the file after sending Sub DeleteFile()    Set objFSO = CreateObject("Scripting.FileSystemObject")    If objFSO.FileExists(strFileName) Then     objFSO.DeleteFile strFileName    End if    Set objFSO = nothing End Sub Sub DisplayErrorInfo    WScript.Echo "Error: : " & Err    WScript.Echo "Error (hex) : &H" & Hex(Err)    WScript.Echo "Source : " & Err.Source    WScript.Echo "Description : " & Err.Description    Err.Clear End Sub

22 comments:

Will Sloan said...

Hey Brian, looks like a cool script. Do you happen to have it available for download? The lines get jumbled there at the bottom and I'm getting syntax errors. It's a big mess in my editor and I thought might be easier to just download it.

Thanks!

Brian Bohanon said...

Will,
I've put the script here for you: http://drop.io/will_sloan

This will be available for 1 year.

Thanks.

Eric said...

Brian, I agree looks like a nice script but the bottom is a little hard to break down. I went to the io site but the vb file is no longer there. Any chance of getting a copy for download.

Brian Bohanon said...

Sorry guys, I read your comments on my Blackberry and didn't realize what you were actually requesting. You can download a zip file of the script from http://drop.io/ServerCheckVBS

I will also try to get back to this post and clean up the bottom of that script. I'm not sure why only the last part is jumbled.

Abhishek said...

I am getting an error.. "Saveas Method of Workbook class Failed. Code 800A03EC, Source Microsoft Office Excel

greavette said...

Change the objWorkbook.SaveAs to:

objWorkbook.SaveAs strDirectory & strLocation & "_Server_Checks_" & Month(Date()) & "_" & Day(Date()) & "_" & Year(Date()) & "_" & Right(Time(),2) & ".xls"

There was an '_' missing before the Right(Time). When I cleaned up my code, it was on line 172. Hope this helps.

Great script by the way!

sachin said...

Hey Brian,looks like a cool script. can you share this with me please.

Brian Bohanon said...

Sachin, I have put made this script available via dropbox.com here: http://dl.dropbox.com/u/3218019/ServerCheck_Generic.vbs

Hope this helps.

Swapnil said...

Hi,

Still the file at the bottom is jumbled. A lot of syntax errors. Please put the script in text file and upload. I will download it and convert it into vbs file.

Is it possible to generate a vbs cript which will tell us the services which are tere on the server and the status of this service on weekly basis.

Swapnil said...

Still the lines are jumbled at the bottom. Please put it in txt file and upload it. I will convert it to vbs.

If possibe put a script which will monitor the services on server and give the status of them weekly. you can how many hours those service were on or off. if it goes through email to the manager. that will be very nice of you.

bhaskar said...

hi all iam unable to down load the script .Request you to re-post the script or give the link to download please....... iam eagerly waiting for the script..

bhaskar said...

hi all iam unable to down load the script .Request you to re-post the script or give the link to download please....... iam eagerly waiting for the script..

Brian Bohanon said...

Swapnil...the file located on Dropbox has been corrected. Sorry it took so long.

As for the services, I have posted a short script here: http://dl.dropbox.com/u/3218019/Get_Services.vbs

I would schedule it to run as a task in combination with the email portion from the check server health script to run weekly. This should give you what you're looking for.

tdx2000 said...

This script would really help me out if I can get it to work. I created a server list and made the changes specified in the script but when I run it I get servercheck.vbs(1, 1) MS VBscript compliation error: Expected statement. Can someone help me out?

Sukanta said...

When I run it, in Line 70 it gives an error.

Line 70 is
For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1

Error: Type Mismatch: 'Ubound'
Code: 800A000D
System: The data is invalid.

Any pointers?

Ajay Elgum said...

This script would really help me out if I can get it to work. I created a server list and made the changes specified in the script but when I run it I get servercheck.vbs(1, 1) MS VBscript compliation error: Expected statement. Can someone help me out?

Raghunath said...

Script: C:\Script\script.vbs
Line: 204
Char: 29
Error: Expected statement
Code : 800A0400
Source: Microsoft VBscript compilation error

Raghunath said...

Script: C:\Script\script.vbs
Line: 204
Char: 29
Error: Expected statement
Code : 800A0400
Source: Microsoft VBscript compilation error

Raghu said...

Script: C:\Script\script.vbs
Line: 204
Char: 29
Error: Expected statement
Code : 800A0400
Source: Microsoft VBscript compilation error

Raghu said...

Script: C:\Script\script.vbs
Line: 204
Char: 29
Error: Expected statement
Code : 800A0400
Source: Microsoft VBscript compilation error

Raghu said...

Script: C:\Script\script.vbs
Line: 204
Char: 29
Error: Expected statement
Code : 800A0400
Source: Microsoft VBscript compilation error

Raghu said...

Script: C:\Script\script.vbs
Line: 29
Char: 1
Error: Type missmatch: 'SendAttach'
Code : 800A000D
Source: Microsoft VBscript runtime error