Morning,
I have been running a script that checks diskspace against a database of servers and emails any problems to my team for us to sort out. I have built in some error traps so that they also get reported if there was a problem with any of this servers or disks when trying to query them. This has been working for a while now with out any problems but today one of the clustered servers was down and the script failed with the following error message:
Line 401
Subscript out of range: '[number: 2]"
800A0009
VBScript runtime error
The storage control block address is invalid
the part of the code in question is below line 401 highlighted with the full code at the end as well. usually the Error Array is empty but sometimes if there is a problem it will generate the error message. Does anyone know what caused this? i had to split the email up in to sections header, table, body, table and footer as i couldnt add it all to one string but Table1 works fine and table2 is the same code just a different array
For Each strError In arrError
If strError <> "" Then
ErrorCount = errorCount + 1
arrErrorReport = Split(strError,",")
table2 = table2 & vbCrLf & "<tr>" _
& vbCrLf & " <td>" & arrErrorReport(0) & "</td>" _
& vbCrLf & " <td>" & arrErrorReport(1) & "</td>" _
& vbCrLf & " <td>" & arrErrorReport(2) & "</td>" _
& vbCrLf & "</tr>"
End If Next
Full Code with email addresses and server names removed
' ####################################################################
'
' Created by Mike Lister 28/07/2011
'
' DiskSpaceCheck - Version 1.5
'
' Description - Check server diskspace and report to Database with email support for errors and report.
'
' Version History
' 1.5 Error trap on the SQL command as it was erroring on EH-APP-D14 when cluster wasn't right
' 1.4 Missed NW from the CASE query
' 1.3 LSA Email function call missing so was missed off the emails
' 1.2 Added free disk Capacity to the Email alert and removed the th widths from the report
' 1.1 Email support added with Errors and Alerts for disks under 5%
' 1.0 Original File run manually with no email support
'
'
' #################################################################### 'Constants
Const adOpenStatic = 3
Const adLockOptimistic = 3 ' #################################################################### 'Global Variables
Version = "1.5"
DatabaseSrc = "e:\DiskSpace.mdb"
arrNumber = 0
Dim strReport
limit = 5
AdminEmail = "itis@xxxx.uk"
SendToCC = ""
ErrorCount = 0
Set objNetwork = CreateObject("Wscript.Network")
strComputer = objNetwork.ComputerName ' ####################################################################
'
'Start
'
' #################################################################### 'Check to make sure the database is accessible
fnCheckForDatabase() 'Connect to Database and Create RecordSet for All Paths to scan
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset") objConnection.Open _
"Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & DatabaseSrc objRecordSet.Open "SELECT * FROM tblServer LEFT JOIN tblPaths ON tblServer.[ServerID] = tblPaths.server WHERE (((tblPaths.active)=True));" , _
objConnection, adOpenStatic, adLockOptimistic objRecordSet.MoveFirst If objRecordSet.RecordCount <> 0 Then 'Create Error Array for storing all errors for the report Dim arrError()
ReDim arrError(objRecordSet.RecordCount) 'Create Error Array for storing all values for the report Dim arrReport()
ReDim arrReport(objRecordSet.RecordCount) Do Until objRecordSet.EOF
'Loop through each record
'Zero out results before next loop starts
FreeSpace = 0
UsedStorage = 0
'Get Storage from Server
UsedStorage = fnGetData(objRecordSet.Fields.Item("ServerName"), objRecordSet.Fields.Item("Path")) 'Check to see if function returned disk space
If UsedStorage = "" Then
arrError(arrNumber) = objRecordSet.Fields.Item("ServerName") & "\" & objRecordSet.Fields.Item("Path") & ",Function returned no data to record against"
Else
'Update the database
fnUpdateDB usedStorage,FreeSpace
'Check the values to find out if its over 5%
fnCheckValues()
End If
'Move through Array to Match RecordSet
arrNumber = arrNumber + 1
objRecordSet.MoveNext
Loop
End If 'Generate Email Report
fnEmailReport Const OverwriteExisting = TRUE Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "e:\DiskSpace.mdb" , "e:\temp\", OverwriteExisting
objFSO.CopyFile "e:\DiskSpace.mdb" , "\\server1\New Disk Space Monitor with DB and Excel\Version " & Version & "\", OverwriteExisting ' ####################################################################
'
'Finish
'
' ####################################################################
' ####################################################################
' ####################################################################
' ####################################################################
' ####################################################################
' ####################################################################
' ####################################################################
' ####################################################################
' ####################################################################
'
' Functions
'
' #################################################################### Function fnCheckForDatabase()
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Create Condition
If (objFSO.FileExists(DatabaseSrc)) Then
'Continue
Else
ErrStr = "Unable to find database " & DatabaseSrc
ErrorMSG(ErrStr)
WScript.Quit(2)
End if
End Function ' #################################################################### Function ErrorMSG(Msg) Set objEmail = CreateObject("CDO.Message")
objEmail.From = "DoNotReply@xxxx.uk"
objEmail.To = "mike.lister@xxxx.uk"
objEmail.Subject = "Script Error - " & WScript.ScriptName
objEmail.Textbody = Msg
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "EH-con-D02"
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send End Function ' #################################################################### Function fnGetData(Server,Path)
'Ignore any errors to complete function
On Error Resume Next
'Reset Error checking
Err.Number = 0 'Connect to server and loop through each disk until Path matches
Set objWMIService = GetObject _
("winmgmts:\\" & Server & "\root\cimv2") 'Trap any errors in the Error Array for Servers that do not exist or can not connect to the WMI
'If Err.Number <> 0 Then
'arrError(arrNumber) = Server & "," & Path & "," & Err.Description
'Err.Clear
'End if Set colItems = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk") 'Traps any errors in the Error Array for problems connecting to the WMI
'If Err.Number <> 0 Then
'arrError(arrNumber) = arrError(arrNumber) & "," & Err.Description
'Err.Clear
'End if For Each objItem in colItems
'Loop through all the Disks found on the Server and check if it matches required one
If UCase(Left(objItem.Name,1)) = UCASE(Path) Then fnGetData = Int(objItem.Size/1024/1024) - Int(objItem.FreeSpace/1024/1024)
FreeSpace = Int(objItem.FreeSpace/1024/1024) End If Next End Function ' #################################################################### Function fnUpdateDB(StorageUsed,StorageFree)
On Error Resume Next
Err.Number = 0
strSQL = "INSERT INTO tblDetails (Path, PollDate, StorageUsedmb, StorageFreemb) values (" & objRecordSet.Fields.Item("PathsID") & ",#" & Date() & "#," & CSng(StorageUsed) & "," & CSng(StorageFree) & ")"
'WScript.Echo strSQL objconnection.Execute (strSQL) If Err.Number <> 0 Then
arrError(arrNumber) = objRecordSet.Fields.Item("ServerName") & "," & objRecordSet.Fields.Item("Path") & "," & Err.Description
Err.Clear
End if End Function ' #################################################################### Function fnCheckValues()
percent = FreeSpace/(FreeSpace+UsedStorage)*100
If percent < limit Then
arrReport(arrNumber) = objRecordSet.Fields.Item("ServerName") & "," & objRecordSet.Fields.Item("Path") & "," & Left(percent,5) & "," & FreeSpace End If End Function ' #################################################################### Function fnEmailReport 'Insert HTML Email with function call to check if a Disk is in a Case and add the LSA if it is Set objEmail = CreateObject("CDO.Message")
objEmail.From = "NoReply@xxxx.uk"
objEmail.To = AdminEmail
'Generate CC List
For Each disk In arrReport
fnPopulateCC(disk)
Next
objEmail.CC = SendToCC
objEmail.Subject = "Disk Space Monitor Update"
objEmail.HTMLbody = fnGenerateBody objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "EH-CON-D01"
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
End Function ' #################################################################### Function fnPopulateCC(disk)
If disk <> "" then
Name = Split(disk,",")
Select Case UCase(Left(Name(0),2))
Case "BH"
SendToCC = SendToCC & "xxxx;"
Case "BR"
SendToCC = SendToCC & "xxxx;"
Case "CV"
SendToCC = SendToCC & "xxxx;"
Case "CR"
SendToCC = SendToCC & "xxxx;"
Case "HQ"
SendToCC = SendToCC & "xxxx;"
Case "PH"
SendToCC = SendToCC & "xxxx;"
Case "DB"
SendToCC = SendToCC & "xxxx;"
Case "GL"
SendToCC = SendToCC & "xxxx;"
Case "HL"
SendToCC = SendToCC & "xxxx;"
Case "LT"
SendToCC = SendToCC & "xxxx;"
Case "LA"
SendToCC = SendToCC & "xxxx;"
Case "NE"
SendToCC = SendToCC & "xxxx;"
Case "NW"
SendToCC = SendToCC & "xxxx;"
Case "PB"
SendToCC = SendToCC & "xxxx;"
Case "PM"
SendToCC = SendToCC & "xxxx;"
Case "TF"
SendToCC = SendToCC & "xxxx;"
Case "TW"
SendToCC = SendToCC & "xxxx;"
Case "WY"
SendToCC = SendToCC & "xxxx;"
Case "YK"
SendToCC = SendToCC & "xxxx;"
Case "WA"
SendToCC = SendToCC & "xxxx;"
Case Else
SendToCC = SendToCC & ""
End Select fnPopulateCC = SendToCC
End if
End Function ' #################################################################### Function fnEmailReport Set objEmail = CreateObject("CDO.Message") objEmail.From = "NoReply@landregistry.gsi.gov.uk"
objEmail.To = AdminEmail
'Generate CC List
For Each disk In arrReport
fnPopulateCC(disk)
Next
objEmail.CC = SendToCC
objEmail.Subject = "Disk Space Monitor Update"
objEmail.HTMLbody = fnGenerateBody objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "eh-con-d01"
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send End Function ' #################################################################### Function fnGenerateBody header = "<html>" _
& vbCrLf & "<head>" _
& vbCrLf & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" _
& vbCrLf & "body{" _
& vbCrLf & "font-family:Arial,Helvetica,sans-serif;" _
& vbCrLf & "font-size:12px;}" _
& vbCrLf & "th {" _
& vbCrLf & " font: bold 13px " & Chr(34) & "Trebuchet MS" & Chr(34) & ", Verdana, Arial, Helvetica," _
& vbCrLf & " sans-serif;" _
& vbCrLf & " color: #6D929B;" _
& vbCrLf & " border-right: 1px solid #C1DAD7;" _
& vbCrLf & " border-bottom: 1px solid #C1DAD7;" _
& vbCrLf & " border-top: 1px solid #C1DAD7;" _
& vbCrLf & " letter-spacing: 2px;" _
& vbCrLf & " text-transform: uppercase;" _
& vbCrLf & " text-align: left;" _
& vbCrLf & " padding: 6px 6px 6px 12px;" _
& vbCrLf & " background: #CAE8EA" _
& vbCrLf & "}" _
& vbCrLf & "td {" _
& vbCrLf & " font-size:11px;" _
& vbCrLf & " border-right: 1px solid #C1DAD7;" _
& vbCrLf & " border-bottom: 1px solid #C1DAD7;" _
& vbCrLf & " background: #fff;" _
& vbCrLf & " padding: 6px 6px 6px 12px;" _
& vbCrLf & " color: #6D929B;" _
& vbCrLf & "}" _
& vbCrLf & "td.alt {" _
& vbCrLf & " font-size:10px;" _
& vbCrLf & " background: #F5FAFA;" _
& vbCrLf & " color: #B4AA9D;" _
& vbCrLf & "}" _
& vbCrLf & ".smalltxt {" _
& vbCrLf & " font-size:9px;" _
& vbCrLf & "}" _
& vbCrLf & "</style>" _
& vbCrLf & "</head>" _
& vbCrLf & "<body>" _
& vbCrLf & "<p>The following report was generated:</p>" _
& vbCrLf & "<p>Servers that have breached the 5% threshold:</p>" _
& vbCrLf & "<table border=" & Chr(34) & "1" & Chr(34) & " cellpadding=" & Chr(34) & "0" & Chr(34) & " cellspacing=" & Chr(34) & "0" & Chr(34) & " style=" & Chr(34) & "border-collapse: collapse" & Chr(34) & " bordercolor=" & Chr(34) & "#111111" & Chr(34) & " width=" & Chr(34) & "515" & Chr(34) & ">" _
& vbCrLf & " <tr>" _
& vbCrLf & " <th>Server</th>" _
& vbCrLf & " <th>Drive Letter</th>" _
& vbCrLf & " <th>Percentage free</th>" _
& vbCrLf & " <th>Storage free</th>" _
& vbCrLf & " </tr>" '
For Each element In arrReport
If element <> "" Then
arrDisk = Split(element,",")
table1 = table1 & " <tr>" _
& vbCrLf & " <td>" & arrDisk(0) & "</td>" _
& vbCrLf & " <td>" & arrDisk(1) & "</td>" _
& vbCrLf & " <td>" & arrDisk(2) & "%</td>" _
& vbCrLf & " <td>" & arrDisk(3) & " MB</td>" _
& vbCrLf & " </tr>"
End If Next
body = "</table><p>" _
& vbCrLf & "<p>The following errors were reported:</p>" & vbCrLf & "<p>"
table2 = vbCrLf & "<table border=" & Chr(34) & "1" & Chr(34) & " cellpadding=" & Chr(34) & "0" & Chr(34) & " cellspacing=" & Chr(34) & "0" & Chr(34) & " style=" & Chr(34) & "border-collapse: collapse" & Chr(34) & " bordercolor=" & Chr(34) & "#111111" & Chr(34) & " width=" & Chr(34) & "515" & Chr(34) & ">" _
& vbCrLf & " <tr>" _
& vbCrLf & " <th>Server</th>" _
& vbCrLf & " <th>Disk</th>" _
& vbCrLf & " <th>Error</th>" _
& vbCrLf & " </tr>" '
RowStyle = "td"
For Each strError In arrError
If strError <> "" Then
ErrorCount = errorCount + 1
arrErrorReport = Split(strError,",")
table2 = table2 & vbCrLf & "<tr>" _
& vbCrLf & " <td>" & arrErrorReport(0) & "</td>" _
& vbCrLf & " <td>" & arrErrorReport(1) & "</td>" _
& vbCrLf & " <td>" & arrErrorReport(2) & "</td>" _
& vbCrLf & "</tr>"
End If Next table2 = table2 & vbCrLf & "</table>"
If errorCount = 0 then
table2 = "<p>No Errors reported</p>"
End if
footer = vbCrLf & "<p> </p>" _
& vbCrLf & "<p class=" & Chr(34) & "smalltxt" & Chr(34) & ">Email generated by " & WScript.ScriptFullName & " on " & strComputer & "</p>" _
& vbCrLf & "</body>" _
& vbCrLf & "</html>"
fnGenerateBody = header & table1 & body & table2 & footer
End Function ' ####################################################################