Submitted By: Donald P. Welker

This script takes the specified folder and lists its contents (including file sizes) in Microsoft Excel. The script is useful for creating listings and for rapidly locating large folders for cleanup.

Visual Basic
Edit|Remove
' xldir.vbs 1.01 by Donald P. Welker
' reads files from dir %1 to %TEMP%\~YYYYMMDDHHMMSS.txt
' in CSV, then launches Excel to view

Const dq = """" ' dbl quote
Const cdq = ",""" ' comma dq
const forwriting = 2

Function Lz(Numb) ' Add leading zeros to single digit
  Dim tmpval
  if isnumeric(Numb) then
      If (Numb>-1) and (Numb<10) Then
          tmpval = "0" & Numb
  Else
        tmpval = CStr(Numb)
  End if ' (Numb>-1) and (Numb<10)
  Else
      tmpval = Null
  end if ' isnumber(Numb)
  Lz = tmpval
End Function ' Lz

Function qt(S) ' surround w/ dq
    qt = dq & S & dq
End Function ' qt

Function cqt(S) ' comma b4 dq
    cqt = "," & qt(S)
End Function ' cqt

Function spitlist(alist) ' CSV
    Dim part, scratch
    scratch = ""
    for each part in alist
        if scratch="" then
            scratch = qt(part)
        else
            scratch = scratch & cqt(part)
        end if ' scratch=""
    next ' part
    spitlist = scratch
End Function

Function filenamext(Fnam)
    Dim f,e ' output string
    	Dim parts ' split name
    Dim i ' counter
    e = ""
    f = ""
    parts = split(Fnam,".")
    if UBound(parts)>0 then
        e = parts(UBound(parts)) ' set it
        f = Left(Fnam,Len(Fnam)-Len(e)-1)
    Else ' no extension
        f = Fnam
    end if ' UBound(parts)>0
    filenamext = qt(f) & cqt(e)
End function ' fext


Function Fattrib(F) ' attributes
    Dim a ' attributes
    Dim s ' scratch string
    s = ""
    a = F.attributes
    ' WScript.Echo F.name & " Attributes: " & a
    if (a and 2048) then s = s & "C" ' Compressed
    if (a and 128) then s = s & "C" ' Compressed
    if (a and 64) then s = s & "L" ' Link
    if (a and 32) then s = s & "A" ' Archive
    if (a and 16) then s = s & "D" ' Directory
    if (a and 8) then s = s & "V" ' Volume label
    if (a and 4) then s = s & "S" ' System
    if (a and 2) then s = s & "H" ' Hidden
    if (a and 1) then s = s & "R" ' Read-only
    Fattrib = s
End Function ' Fattrib

Function ListFolderProps(F)
    Dim s,prop ' property string to be built
    'WScript.Echo "FolderProps: " & F.path
    s = qt(F.name) & cdq & dq
on error resume next ' deals with permissions issues
    s = s & cqt(F.Size)
    if Err.Number=70 Then s = s & cqt("")
on error goto 0
    s = s & cqt(Fattrib(F)) '& vbCrLf 
    s = s & cqt(F.DateCreated) & cqt(F.DateLastAccessed)
    s = s & cqt(F.DateLastModified)
    s = s & cqt(F.Type)
    s = s '& vbCrLf
    'Wscript.echo s
    ListFolderProps = s
End Function ' ListFolderProps

Function ListFileProps(F)
    Dim s,prop ' property string to be built
    'WScript.Echo "FileProps: " & F.path
    s = filenamext(F.name) 
    s = s & cqt(F.Size) & cqt(Fattrib(F)) '& vbCrLf 
    	s = s & cqt(F.DateCreated) & cqt(F.DateLastAccessed)
    s = s & cqt(F.DateLastModified)
    s = s & cqt(F.Type)
    s = s '& vbCrLf
    'Wscript.echo s
    ListFileProps = s
End Function ' ListFileProps

' ON ERROR RESUME NEXT

' VARIABLE DECLARATIONS
Dim dTheTime   ' Current time
Dim sTS        ' Timestamp
Dim sNew       ' New file name
Dim args       ' script arguments
Dim fso        ' filesystem object 
Dim xlo        ' Excel object
Dim fn         ' folder name string
Dim f          ' file handle
Dim fxl        ' handle for csv file (textstream object)
Dim fxlfn      ' name of csv file
Dim ext        ' file extension
Dim parts      ' array of parsed filename parts
Dim part       ' single string item from split string
Dim partstr    ' comma-delimited string
Dim objShell   ' Scripting shell object
Dim fl,fld     ' scratch file and folder, respectively
Dim tmpfld     ' temp folder

' MAIN
dTheTime = Now
sTS = Year(dTheTime) & Lz(Month(dTheTime)) & Lz(Day(dTheTime)) 
sTS = sTS & Lz(Hour(dTheTime)) & Lz(Minute(dTheTime)) & Lz(Second(dTheTime))
fxlfn = "~" & sTS & ".CSV" '

Set args = WScript.Arguments
if args.unnamed.count >=1 then
    fn = args(0) ' folder name
else
    WScript.Quit(-1)
end if ' args.unnamed.count >=1

Set objShell = CreateObject("WScript.Shell") ' get the shell
tmpfld = objShell.ExpandEnvironmentStrings("%TEMP%")

fxlfn = tmpfld & "\" & fxlfn

Set fso = CreateObject("Scripting.FileSystemObject")

if fso.FolderExists(fn) Then

    Set f = fso.GetFolder(fn)

    set fxl = fso.OpenTextFile(fxlfn,ForWriting,True)

    fxl.WriteLine qt("Filename") & cqt("Ext") & cqt("Bytes") _
        & cqt("Attr") & cqt("DateCreated") & cqt("DateLastAccessed") _
        & cqt("DateLastModified") & cqt("Type")
    parts = Split(f.path,"\")
    partstr = dq & f.path & dq & "," & spitlist(parts)

    for each fld in f.subfolders
        fxl.WriteLine ListFolderProps(fld)
    next ' folder

    for each fl in f.files
        fxl.WriteLine ListFileProps(fl)
    next ' file

    fxl.WriteLine vbCrLf & partstr

    fxl.close

    set xlo=CreateObject("Excel.Application")
    with xlo.application
       .Workbooks.Open(fxlfn)
       .visible = true
       .Windows(fso.getfilename(fxlfn)).Activate
       for z=65 to 72
           ch = Chr(z) & ":" & chr(z)
           .Columns(ch).EntireColumn.AutoFit
       next ' z

        .ActiveWorkBook.Saved = True ' bypass prompts
    end with ' xlo.application
else
    WScript.Quit(-1) ' not found
end if

WScript.Quit(0) ' normal exit