need script help

[Divyesh Raithatha]

Take a look at the following code. What I am trying to do
is to output a list subfolders within a folder and their
sizes. The code works except that I can only output hte
last subfolder name and information. It does not list all
the subfolders...just one...the last subfolder
alaphabetically. I would like to list all the
subfolders. I think there should be a loop element when
the data is being written to the excel file.

Thanks,
Divyesh


option explicit
dim f, fso, fSize, drives, drive, objXL, objWB,
strComputer,objWMIService, objLogicalDisk, FreeMegaBytes,
SizeMegaBytes
Dim objWS, myExcelFile, iRow, excelWorkbookExists,
excelRunning, myWBname, excelWorkbookOpen
dim objFolder, colSubfolders, objSubfolder
myWBname = "test.xls"
myExcelFile = "C:\" & myWBname
iRow = 2
excelWorkbookOpen = False
excelRunning = True
On Error Resume Next
Set objXL = GetObject(, "Excel.Application") 'Get object
if Excel is open
If Err.Number <> 0 Then
excelRunning = False
Set objXL = CreateObject("Excel.Application") 'Create
object if Excel is not open
End If
On Error GoTo 0
If excelRunning Then
On Error Resume Next
Set objWB = objXL.Workbooks(myWBname) 'Set if target
Workbook open
End If
On Error GoTo 0
If IsEmpty(objWB) Then
On Error Resume Next
Set objWB = objXL.Workbooks.Open(myExcelFile) 'Open if
WorkBook not open
Else
excelWorkbookOpen = True
End If
On Error GoTo 0
If IsEmpty(objWB) Then ' Create sheet if needed
excelWorkbookExists = False
Set objWB = objXL.Workbooks.Add
Set objWS = objWB.Sheets.Add
objWS.Name = "Folders"
objWS.Cells(1,1) = "Name"
objWS.Cells(1,2) = "Size"
objWS.Cells(1,3) = "Date"

Else 'find next open cell if sheet exists
excelWorkbookExists = True
Set objWS = objWB.Sheets("Folders")
Do While objWS.Cells(iRow, 1) <> ""
iRow = iRow + 1
Loop
End If
Err.Clear
On Error GoTo 0

Set fso = createobject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder("\\SERVER\FOLDER")
Set colSubfolders = objFolder.Subfolders


For Each objSubfolder in colSubfolders
Do While colSubfolders>1
objWS.Cells(iRow, 1) = objSubFolder.Name
objWS.Cells(iRow, 2) = int(objSubFolder.Size/1048576)
objWS.Cells(iRow, 3) = Date()
Loop
Next


If excelWorkbookExists Then
objWB.Save
Else
objWB.SaveAs myExcelFile
End If
If Not excelWorkbookOpen Then objWB.Close
If Not excelRunning Then objXL.Quit

 

[Harald Staff]

Hi Divyesh

If I read this correctly, you forgot a counter far down:

objWS.Cells(iRow, 3) = Date()
iRow = iRow+1
Loop