Limit subfolder recursion?

[smurfhell]

Currently I am using this borrowed script:

'==========================================================================
'
' NAME: getFolderSizes2XL.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: [URL unfurl="true"]http://www.thespidersparlor.com[/URL]
' DATE  : 11/21/2004
'
' COMMENT: <comment>
'
'==========================================================================
Dim oFS, oFolder
Dim objexcel, r, lnameArray, lname, nameLength
set oFS = WScript.CreateObject("Scripting.FileSystemObject")
set oFolder = oFS.GetFolder("C:\Documents and Settings")

Set objExcel = createobject("Excel.application")   
objexcel.Workbooks.add
objexcel.Cells(1, 1).Value = "Folder Name"
objexcel.Cells(1, 2).Value = "Size (MB)"
objexcel.Cells(1, 3).Value = "# Files"
objexcel.Cells(1, 4).Value = "# Sub Folders"
objexcel.Visible = True
Wscript.Sleep 300
r=2


ShowFolderDetails oFolder, r

    
    
'    objexcel.ActiveWorkbook.SaveAs("LogonReport.xls")
'    objexcel.Quit
MsgBox "Done"    
    
Function ShowFolderDetails(oF,r)
    Dim F
    objexcel.Cells(r, 1).Value = oF.Name
    objexcel.Cells(r, 2).Value = oF.Size /1024\1024
    objexcel.Cells(r, 3).Value =  oF.Files.Count
    objexcel.Cells(r, 4).Value =  oF.Subfolders.count
    r = r+1
    for each F in oF.Subfolders
        ShowFolderDetails F, r
    next
End Function

However, I don't want to search every single subfolder. I have one main folder with user folders under it and subfolders in the user folders. I only want to scan the user folders. Is this possible?

 

[PHV]

Something like this ?
...
ShowFolderDetails oFolder, r, 1evel
...
Function ShowFolderDetails(oF,r,level)
...
If level = 1 Then
for each F in oF.Subfolders
ShowFolderDetails F, r, 2
next
End If
End Function

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[dskelley]

On a simliar note, I'm using the below script to simply do a first-level folder report to a text file. I need help to use this same report but to export it to an existing Excel spreadsheet in specifically designated cells. Any assistance would be appreciated.

'Report on number of first-level folders from UNC path provided in an inputfile.
'Devin S Kelley 2004
on error resume next
'Set up Initial key Variables-----------------------
dim oFolder
'Argument Capture-----------------------------------
if wscript.arguments.count=0 then
thefile=inputbox("Enter the Input File's Name : "&vbcrlf&"Example : My input file.txt","Input file Name","input.txt")
othefile=thefile
if thefile="" then
wscript.quit
end if
else
'Use the FileName supplied as an argument
thefile=wscript.arguments(0)
opos=instrrev(thefile,"\")
opath=mid(thefile,1,opos)
othefile=mid(thefile,opos+1,len(thefile))
end if
'---------------------------------------------------

outputfilename="Folder Count report for "&othefile


'---------------------------------------------------
'Open Files for reading and writing-----------------
set ofs=createobject("scripting.filesystemobject")
if not ofs.fileexists(thefile) then
'File Not Found Exit Application
wscript.echo "Input File Not Found"
wscript.quit
end if
set outputFile = ofs.createtextfile(opath&outputfilename)
outputfile.writeline("UNC Path"&vbtab&"Folder Count")
set ologfile=ofs.createtextfile(opath&"ProcessLog.txt")
set oinputFile = ofs.opentextfile(thefile,1,False)
ologfile.writeline(now&vbtab&" "&othefile&" Opened")
Set onet=Wscript.CreateObject("Wscript.Network")
Set osh=createobject("WScript.Shell")
'---------------------------------------------------
'BEGIN Main Program
'---------------------------------------------------
Do while not oinputfile.AtEndOfStream
ouncpath=oinputfile.Readline
ologfile.writeline(now&vbtab&" Processing "&ouncpath)
oflag=0
getinfo ouncpath
if oflag=0 then
goreport ouncpath
else
ologfile.writeline(now&vbtab&" * ERROR! Invalid UNC Path "&ouncpath)
end if
ologfile.writeline(now&vbtab&" Processing "&ouncpath&" Completed")
loop
'---------------------------------------------------
oinputfile.close
ologfile.close
outputfile.close
'---------------------------------------------------
'END Main Program
'---------------------------------------------------
'---------------------------------------------------
sub goreport(unc)
'------------------------------
on error resume next
outputfile.writeline(unc&vbtab&oFolder)
'------------------------------
end sub
'---------------------------------------------------
sub getinfo(uncpath)
'------------------------------
'on error resume next
' if ofs.folderexists(uncpath) then
' set objfolder=ofs.getfolder(uncpath)
' oFolder=objfolder.size
'listsubfolders objfolder
'else
'oflag=1
'end if

on error resume next
if ofs.folderexists(uncpath) then
set objfolder=ofs.getfolder(uncpath)
oFolder=objfolder.subfolders.count
listsubfolders objfolder
else
oflag=1
end if
'------------------------------
end sub
'---------------------------------------------------
if not err.number=0 then
wscript.echo err.number&vbcrlf&err.description
end if
'End of Program-------------------------------------
wscript.echo "Report Complete"&vbcrlf&"End Program

 

[smurfhell]

The easiest way for me to do this was by changing the function just a bit after writing an "For each" statement and creating a subfolder collection.

Dim objFSO, objFolder
Dim objexcel, r 
set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
set objFolder = objFSO.GetFolder("U:\")
set colSub = objFolder.subfolders
 
Set objExcel = createobject("Excel.application")   
objexcel.Workbooks.add
objexcel.Cells(1, 1).Value = "Folder Name"
objexcel.Cells(1, 2).Value = "Size (MB)"
objexcel.Cells(1, 3).Value = "# Files"
objexcel.Cells(1, 4).Value = "# Sub Folders"
objexcel.Visible = True
r=2

for Each objsub in colsub
ShowSub objsub, r
next
MsgBox "Done"    
    
Function ShowSub (objsub, r)
    objexcel.Cells(r, 1).Value = objsub.Name
    objexcel.Cells(r, 2).Value = objsub.Size /1024\1024
    objexcel.Cells(r, 3).Value = objsub.Files.Count
    objexcel.Cells(r, 4).Value = objsub.Subfolders.count
    r = r+1
    End Function