'===================================================
'= Purpose: Check disk space on multiple disks 
'=   with 0 (or close to) impact on     
'=   server resources.     
'= Author: Tom McGeown      
'= Date: 16/06/2007
'= Change: 03/07/2007      
'====================================================
'*****DECLARE VARIABLES CREATE OBJECTS ETC*****
Option Explicit
dim strcomputer, objExcel, objWorkBook, objWorkSheet, objWMIService, colDisks
dim objDisk, i, freespace, arrNames(), intSize, currentsheet, strToday, strTime, objWorkingSheet
dim letter, path, strSize, strUsed, strChange, colItems, objNetwork, DiskList, arrDisks, Disk, strServer
'*****LOCAL COMPUTER*****
strComputer = "."
'SERVER TO BE CHECKED - DONT FORGET THE "\"
strServer = "\\yourserver\"
'*****CALL EXCEL APPLICATION*****
Set objExcel = CreateObject("Excel.Application")
'*****SPREADSHEET DEFINED BELOW SHOULD HAVE A WORKSHEET NAMED AFTER EACH DISK YOU WISH TO CHECK*****
Set objWorkbook = objExcel.Workbooks.Open("full path to your spreadsheet.xls")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
objExcel.Visible = True
'*****THIS IS THE DRIVE LETTER EACH DISK WILL BE MAPPED TOO. CHOOSE SOMETHING NOT CURRENTLY IN USE-WILL DELETE ANY EXISITING MAPPING*****
Letter = "Z"
'*****LIST OF DISKS TO CHECK ON SERVER*****
DiskList = "C,D"
arrDisks = Split(DiskList, ",")
'*****CALL FUNCTIONS TO MAP DRIVE, CHECK SPACE AND DELETE MAPPING FOR EACH DISK*****
For Each Disk in arrDisks
 Path = strServer & Disk & "$"
 DeleteDrive Letter
 MapDrive Letter, Path
 RetrieveData Disk
Next
'*****SAVE CHANGES*****
objWorkbook.Save()
'*****CLOSE WORKBOOK******
objWorkbook.Close()
'*****CLEAN UP REMAINING MAPPINGS*****
DeleteDrive Letter
'***** ALL FUNCTIONS FOLLOW****
Function RetrieveData(Disk)
        '*****QUERY WMI FOR MAPPED DRIVES*****
 Set colDisks = objWMIService.ExecQuery ("Select * from Win32_MappedLogicalDisk")
 intsize = 1
 '*****LOOP THROUGH THE WORKSHEETS IN THE SPREADSHEET*****
 For Each objWorksheet in objWorkbook.Sheets
  'IF SHEETNAME MATCHES DISK NAME
  If objWorksheet.Name = Disk then 
   '*****SET SHEET TO WORK ON*****
   set objWorkingsheet = objWorkBook.WorkSheets(intSize)
  End If
  intSize = intSize + 1
 Next
 '*****GET DATE AND TIME
 strToday = Date()
 strTime = Time()
 i = 2
 '*****FIND FIRST EMPTY ROW
 Do Until objWorkingsheet.Cells(i, 5).Value = ""
  i= i + 1
 loop
 '*****CHECK EACH MAPPED DRIVE
 For Each objDisk in colDisks
  '*****IF THE DRIVE IS THE ONE WE MAPPED*****
  If objDisk.DeviceID = Letter & ":" Then
   '*****GET DISK SIZE*****
   strSize = objDisk.Size
   '*****GET DISK FREE SPACE
   freespace = objDisk.FreeSpace
   '*****WRITE TIME AND DATE TO SHEET
   objWorkingsheet.Cells(i, 1).Value = strToday
   objWorkingsheet.Cells(i, 2).Value = strTime
   '*****WRITE DISK SIZE IN GB*****
   objWorkingsheet.Cells(i, 3).Value = FormatNumber(strSize /1024 /1024 /1024, 2)
   '*****WRITE FORMULA TO SHEET TO CALCULATE USED SPACE*****
   strUsed =  "=C" & i & "-E" & i
   objWorkingsheet.Cells(i, 4).Value = strUsed
   '*****WRITE FREE SPACE IN GB*****
   objWorkingsheet.Cells(i, 5).Value = FormatNumber(freespace  /1024 /1024 /1024, 2)
   '*****WRITE FORMULA TO SHEET TO CALCULATE CHANGE IN SPACE SINCE LAST CHECK*****
   strChange = "=E" & i-1 & "-e" & i
   objWorkingsheet.Cells(i, 6).Value = strChange
  End If
 Next
End Function
'*****FUNCTION TO MAP A DRIVE*****
Function MapDrive(Letter, Path)
        '*****QUERY WMI FOR OUR MAPPED DRIVE*****
 Set colItems = objWMIService.ExecQuery ("Select * From Win32_LogicalDisk Where DeviceID = '" & Letter & ":'")
 '*****CHECK IF MAPPED DRIVE DOESNT EXISTS*****
 If colItems.Count = 0 Then
  '*****CREATE WSCRIPT NETWORK OBJECT*****
  Set objNetwork = CreateObject("Wscript.Network")
  '*****CREATE MAPPED DRIVE*****
  objNetwork.MapNetworkDrive Letter & ":", Path
 End If
End Function
'*****FUNCTION TO DELETE MAPPED DRIVE*****
Function DeleteDrive(Letter)
        '*****QUERY WMI FOR OUR MAPPED DRIVE*****
 Set colItems = objWMIService.ExecQuery ("Select * From Win32_LogicalDisk Where DeviceID = '" & Letter & ":'")
 '*****CHECK IF MAPPED DRIVE EXISTS*****
 If colItems.Count = 1 Then
  '*****CREATE WSCRIPT NETWORK OBJECT*****
  Set objNetwork = CreateObject("Wscript.Network")
  '*****DELETE MAPPED DRIVE*****
  objNetwork.RemoveNetworkDrive Letter & ":"
 End If
End Function