VBS Script To Browse For Folder And Send Sub Folders Name And Size To Excel

 

This VBS Script will allow to browse for a directory folder and will write the subfolders name and size to an excel spreadsheet.

 

VBS Script:

 

strComputer = "."

 

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.BrowseForFolder (0, "Select Folder:", (0))

If objFolder Is Nothing Then

Wscript.Quit

Else

Set objFolderItem = objFolder.Self

objPath = objFolderItem.Path

End If

 

Set objFolderItem = objWMIService.ExecQuery _

("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _

& "Where AssocClass = Win32_Subdirectory " _

& "ResultRole = PartComponent")

 

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.Workbooks.Add

intRow = 2

 

objExcel.Cells(1, 1).Value = "Folder"

objExcel.Cells(1, 2).Value = "Size"

 

Set objShell = CreateObject ("Shell.Application")

For Each strFileName in objFolder.Items

objExcel.Cells(intRow, 1).Value = objFolder.GetDetailsOf(strFileName, 0)

objExcel.Cells(intRow, 2).Value = objFolder.GetDetailsOf(strFileName, 8)

intRow = intRow + 1

Next

 

objExcel.Range("A1:B1").Select

objExcel.Selection.Interior.ColorIndex = 19

objExcel.Selection.Font.ColorIndex = 11

objExcel.Selection.Font.Bold = True

objExcel.Cells.EntireColumn.AutoFit

 

MsgBox "Done"

 

 

 

Published Sunday, August 24, 2008 1:07 PM by dhite
Filed under:

Comments

No Comments