' This script to get drive space
'
' Revision history :
' Solihin - 18 July 2008 - Initial Coding
' solihinho.wordpress.com
Option Explicit
Dim objWMIService, objItem, colItems
Dim strDriveType, strDiskSize, strDisk
Dim strServer, strListServer
Dim sReportTitle
Dim sFileName, sScriptPath
Dim sEmailTo, sEmailFrom, sEmailSubject, sEmailBody
Dim oFso
Dim sQuery
'On Error Resume Next
'Init Variable
strListServer = ReadIni("setting.ini", "ServerList", "Name")
sReportTitle = "Report Space Drive Information"
strServer = Split(strListServer,",")
sQuery = "SELECT * FROM Win32_LogicalDisk"
Set oFso = CreateObject("Scripting.FileSystemObject")
sFileName = ReadIni( "setting.ini", "Excel", "FileName")
'Write and format result file
sScriptPath = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, ""))
sFilename = sScriptPath & sFilename
'delete file if exists
If oFso.FileExists(sFilename) then
oFso.DeleteFile sFilename, True
end If
FormatXLS (sFileName)
Dim oExcel, oWb, oSheet, oRange
Dim iRow, iStartRow
Dim compName
If ReadIni( "setting.ini", "Email", "SentEmail" ) = "True" Then
sEmailTo = ReadIni( "setting.ini", "Email", "To" )
sEmailFrom = ReadIni( "setting.ini", "Email", "From" )
sEmailSubject = ReadIni( "setting.ini", "Email", "Subject" )
sEmailBody = ReadIni( "setting.ini", "Email", "Body1") & vbcrlf &_
ReadIni( "setting.ini", "Email", "Body2")
SendMail (sFileName)
End If
'procedure write to excel
Sub FormatXLS (sFileName)
'Create excel object, exit if object not exists
Set oExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then Exit Sub
If IsNull(oExcel) Then Exit Sub
oExcel.Visible = ReadIni( "setting.ini", "Excel", "IsVisible" )
'Create a workbook
Set oWb = oExcel.Workbooks.Add
'Bind to worksheet
Set oSheet = oExcel.ActiveWorkbook.Worksheets(1)
oSheet.Name = "Local Drive"
oExcel.Cells.EntireColumn.Font.Name = "Verdana"
iRow = 1
oSheet.Cells(iRow, 1).Value = sReportTitle
iRow = iRow + 1
oSheet.Cells(iRow, 1).Value = "Report Date : " & Date & " " & Time
oSheet.Cells(iRow,1).Font.Size = 10
oSheet.Cells(iRow,1).Font.Italic = True
iRow = iRow + 2
For Each compName In strServer
Set objWMIService = GetObject ("winmgmts:\" & compName & "rootcimv2")
Set colItems = objWMIService.ExecQuery (sQuery)
'header
oSheet.Cells(iRow, 1).Value = "Server : " & compName
oSheet.Cells(iRow, 1).Font.Bold = True
iRow = iRow + 1
iStartRow = iRow
'initiate column
oSheet.Cells(iRow, 1).Value = "Drive"
oSheet.Cells(iRow, 2).Value = "Drive Type"
oSheet.Cells(iRow, 3).Value = "Disk Size"
oSheet.Cells(iRow, 4).Value = "Disk Used"
oSheet.Cells(iRow, 5).Value = "Free Space"
oSheet.Cells(iRow, 6).Value = "% Free Space"
Set oRange = oExcel.Range("A" & iRow, "F" & iRow)
oRange.Font.Italic = True
oRange.Interior.ColorIndex = 15
iRow = iRow + 1
For Each objItem in colItems
Select Case objItem.DriveType
Case 1 strDriveType = "Drive could not be determined."
Case 2 strDriveType = "Removable Drive"
Case 3 strDriveType = "Local hard disk."
Case 4 strDriveType = "Network disk."
Case 5 strDriveType = "Compact disk (CD)"
Case 6 strDriveType = "RAM disk."
Case Else strDriveType = "Drive type Problem."
End Select
If IsNull(objItem.Size) Then
strDiskSize = ""
ElseIf objItem.DriveType = 2 Then
strDiskSize = CDbl(FormatNumber(objItem.Size /1048576)) &_
" Mega Bytes"
Else
strDiskSize = CDbl(FormatNumber(objItem.Size /1073741824,2)) & " GB"
End If
If ObjItem.Size <> "" Then
oSheet.Cells(iRow, 1).Value = objItem.Name
oSheet.Cells(iRow, 2).Value = strDriveType
oSheet.Cells(iRow, 3).Value = strDiskSize
oSheet.Cells(iRow, 3).HorizontalAlignment = -4152 'xlRight
oSheet.Cells(iRow, 4).Value = CDbl(FormatNumber((objItem.Size _
- objItem.FreeSpace) / 1073741824)) & " GB"
oSheet.Cells(iRow, 4).HorizontalAlignment = -4152 'xlRight
oSheet.Cells(iRow, 5).Value = CDbl(FormatNumber(objItem.FreeSpace _
/1073741824)) & " GB"
oSheet.Cells(iRow, 5).HorizontalAlignment = -4152 'xlRight
oSheet.Cells(iRow, 6).Value = CDbl(FormatNumber(objItem.FreeSpace _
/objItem.Size * 100)) & " %"
oSheet.Cells(iRow, 6).HorizontalAlignment = -4152 'xlRight
iRow = iRow + 1
End If
Next 'End For
'frame
Set oRange = oExcel.Range("A" & iStartRow & ":F" & iRow-1)
oRange.Activate
With oRange.Borders(7) ' Left
.Weight = 2 'xlThin
End With
With oRange.Borders(8) ' Top
.Weight = 2
End With
With oRange.Borders(9) ' Bottom
.Weight = 2
End With
With oRange.Borders(10) ' Right
.Weight = 2
End With
With oRange.Borders(11) ' Inside Vertical
.Weight = 2
End With
With oRange.Borders(12) ' Inside Horizontal
.Weight = 2
End With
iRow = iRow + 1
Next 'End For
'set all colums autofit
Set oRange = oExcel.Range("A1")
oRange.Activate
oRange.ColumnWidth = 6
Set oRange = oExcel.Range("B1")
oRange.Activate
Set oRange = oExcel.ActiveCell.EntireColumn
oRange.AutoFit()
Set oRange = oExcel.Range("C1")
oRange.Activate
Set oRange = oExcel.ActiveCell.EntireColumn
oRange.AutoFit()
Set oRange = oExcel.Range("D1")
oRange.Activate
Set oRange = oExcel.ActiveCell.EntireColumn
oRange.AutoFit()
Set oRange = oExcel.Range("E1")
oRange.Activate
Set oRange = oExcel.ActiveCell.EntireColumn
oRange.AutoFit()
Set oRange = oExcel.Range("F1")
oRange.Activate
Set oRange = oExcel.ActiveCell.EntireColumn
oRange.AutoFit()
'Save as excel file
oExcel.ActiveWorkbook.SaveAs sFileName, 1, "", "", False, False
oExcel.Workbooks.Close
Set oSheet = Nothing
Set oExcel = Nothing
End Sub
'procedure to send email
Sub SendMail(sFileName)
'On Error Resume Next
'Create email object, exit if object not exists
Set oEmail = CreateObject("CDONTS.NewMail")
If Err.Number <> 0 Then Exit Sub
If IsNull(oEmail) Then Exit Sub
'Send mail with attachment
oEmail.From = sEmailFrom
oEmail.To = sEmailTo
oEmail.Bcc = sEmailBcc
oEmail.Subject = sEmailSubject
oEmail.Body = sEmailBody
If oFso.FileExists(sFileName) Then
oEmail.AttachFile sFileName
oEmail.Send
ElseIf oFso.FileExists(sFileName) Then
oEmail.AttachFile sFileName
oEmail.Send
End If
Set oEmail = Nothing
End Sub
Function ReadIni( myFilePath, mySection, myKey )
' This function returns a value read from an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be returned
'
' Returns:
' the [string] value for the specified key in the specified section
'
' CAVEAT: Will return a space if key exists but value is blank
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim intEqualPos
Dim objFSO, objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection
Set objFSO = CreateObject("Scripting.FileSystemObject")
ReadIni = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
If objFSO.FileExists( strFilePath ) Then
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False)
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
'Check if section is found in the current line
If LCase( strLine ) = "[" & LCase(strSection) & "]" Then
strLine = Trim( objIniFile.ReadLine)
'Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
'Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim(Left(strLine,intEqualPos - 1))
'Check if item is found in the current line
If LCase(strLeftString) = LCase(strKey) Then
ReadIni = Trim(Mid(strLine, intEqualPos + 1))
'In case the item exists but value is blank
If ReadIni = "" Then
ReadIni = " "
End If
'Abort loop when item is found
Exit Do
End If
End If
'Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
'Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
Else
WScript.Echo strFilePath & " doesn't exists. Exiting..."
Wscript.Quit 1
End If
End Function
|