asked on
ASKER
' Define constants
Const cSharesFile = "c:\temp\EE26608584\shares.txt"
Const cExcelFile = "c:\temp\EE26608584\usage.xlsx"
Const cHeaders = "Server Share;Usage;Total Space;Used Space;Free Space"
Const cExcel7 = 51
' Read list of shares into arrary
Set objFSO = CreateObject("Scripting.FilesystemObject")
Set objSharesFile = objFSO.OpenTextFile(cSharesFile, 1)
arrPaths = Split(objSharesFile.ReadAll, vbNewLine)
objSharesFile.Close
' Start Excel, create a new worksheet
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.Workbooks.Add
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
' Initialize row and column indexes
intCol = 1
intRow = 1
' Write header row
For Each strHeader In Split(cHeaders, ";")
objSheet.Cells(intRow, intCol).Value = strHeader
intCol = intCol + 1
Next
' Process each share
For Each strPath in arrPaths
If strPath <> "" Then
intRow = intRow + 1
arrTokens = Split(strPath, "\")
strShare = arrTokens(UBound(arrTokens))
strServer = arrTokens(UBound(arrTokens) - 1)
strFull = ""
numSize = ""
numFree = ""
' Enumerate share
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
Set colShares = objWMI.ExecQuery("Select Path from Win32_Share where name = '" & strShare & "'")
' Get drive share is on
For Each objShare In colShares
strFull = objShare.Path
strDrive = Split(objShare.Path, ":")(0)
Exit For
Next
' Get space info for drive
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
Set colItems = objWMI.ExecQuery("Select FreeSpace,Size from Win32_LogicalDisk where Name='" & strDrive & ":'")
For Each objItem in colItems
numSize = (objItem.Size / 1073741824)
numFree = (objItem.FreeSpace / 1073741824)
numUsed = numSize - numFree
numPercent = numUsed / numSize
Exit For
Next
' Store data in Excel
objSheet.Cells(intRow, 1).Value = strPath
objSheet.Cells(intRow, 2).Value = numPercent
objSheet.Cells(intRow, 3).Value = numSize
objSheet.Cells(intRow, 4).Value = numUsed
objSheet.Cells(intRow, 5).Value = numFree
End If
Next
' Save excel file, close excel
objExcel.DisplayAlerts = False
objExcel.ActiveWorkbook.SaveAs cExcelFile, cExcel7
objExcel.ActiveWorkbook.Close False
objExcel.Application.Quit
' Wrap up
Set objSheet = Nothing
Set objExcel = Nothing
ASKER
ASKER
The Microsoft Legacy Operating System topic includes legacy versions of Microsoft operating systems prior to Windows 2000: All versions of MS-DOS and other versions developed for specific manufacturers and Windows 3/3.1, Windows 95 and Windows 98, plus any other Windows-related versions, and Windows Mobile.
TRUSTED BY
~bp