McKirahan
Tue Mar 18 11:25:36 CDT 2008
"Mithesh" <Mithesh@discussions.microsoft.com> wrote in message
news:EAD2484C-8FD2-404F-B3B0-17F0D5B3DDC2@microsoft.com...
> Please refer to the below vb script
>
> Dim oFS, oFolder
> Dim objexcel, r, lnameArray, lname, nameLength
> set oFS = WScript.CreateObject("Scripting.FileSystemObject")
> set oFolder = oFS.GetFolder("C:\test")
>
> 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 20
> r=2
>
>
> ShowFolderDetails oFolder, r
>
>
>
> objexcel.ActiveWorkbook.SaveAs("C:\FolderReport.xls")
> objexcel.Quit
>
>
> 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
>
> Instead of the folder test, i require the script to search folder based on
> date - specifically folder created on the previous date.
Change the folder referenced in this line to the folder you want:
set oFolder = oFS.GetFolder("C:\test")
It is unclear from your description what folder you want.
Do you mean subfolders created yesterday or anytime before today?
Note that the script does two things badly:
1) It does not store numeric folder names as text; thus "01" is "1".
2) It does not store the full path to sub-subfolders.
Perhaps you got the script from this URL:
http://www.tek-tips.com/viewthread.cfm?qid=954944
The variables "lnameArray", "lname", and "nameLength" are unused.
Will this version help? This formats the workbook and fixes the errors.
Option Explicit
'****
'* Create MS-Excel workbook "cXLS" that lists properties
'* of folder "cFOL" and all of its subfolders.
'****
'*
'* Declare Constants
'*
Const cVBS = "Folder_Report.vbs"
Const cXLS = "Folder_Report.xls"
Const cFOL = "C:\Test\"
Const cCOL = "|Folder Name|Size (MB)|# Files|# Sub Folders"
'*
'* Declare Variables
'*
Dim arrCOL
arrCOL = Split(cCOL,"|")
Dim intCOL
Dim strDIR
strDIR = WScript.ScriptFullName
strDIR = Left(strDIR,InStrRev(strDIR,"\"))
Dim strFOL
Dim strRNG
Dim intROW
intROW = 1
Dim strSUB
'*
'* Declare Objects
'*
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strDIR & cXLS) Then
objFSO.DeleteFile(strDIR & cXLS)
End If
Dim objGFO
Set objGFO = objFSO.GetFolder(cFOL)
Dim objXLA
Set objXLA = CreateObject("Excel.Application")
objXLA.Visible = True
objXLA.Workbooks.Add
objXLA.Worksheets("Sheet1").PageSetup.LeftHeader = cFOL
objXLA.Worksheets("Sheet1").PageSetup.RightHeader = Now
objXLA.Worksheets("Sheet1").PageSetup.PrintTitleRows = "1:1"
objXLA.Worksheets("Sheet1").PageSetup.PrintGridlines = 1
'*
'* Process Folder
'*
For intCOL = 1 To UBound(arrCOL)
objXLA.Cells(intROW,intCOL).Value = arrCOL(intCOL)
Next
Call Folder_Details(objGFO)
'*
'* Process Complete
'*
strRNG = "A1:" & Chr(64+UBound(arrCOL)) & "1"
objXLA.Range(strRNG).Select
objXLA.Selection.Font.Bold = True
strRNG = "A1:" & Chr(64+UBound(arrCOL)) & intROW
objXLA.Range(strRNG).Select
objXLA.Selection.Font.Name = "Arial"
objXLA.Selection.Font.Size = 9
objXLA.Cells.EntireColumn.AutoFit
objXLA.ActiveWorkbook.SaveAs(strDIR & cXLS)
objXLA.Quit
Set objXLA = Nothing
'*
MsgBox intROW & " rows",vbInformation,cVBS
Sub Folder_Details(folder)
intROW = intROW + 1
strSUB = folder
If Len(strSUB) > Len(cFOL) Then strSUB = Mid(strSUB,Len(cFOL))
objXLA.Cells(intROW,1).Value = strSUB
objXLA.Cells(intROW,2).Value = FormatNumber(folder.Size/1024/1024,1)
objXLA.Cells(intROW,3).Value = folder.Files.Count
objXLA.Cells(intROW,4).Value = folder.Subfolders.Count
For Each strFOL In objFSO.GetFolder(folder).SubFolders
Call Folder_Details(strFOL)
Next
End Sub