Below is a VBScript example of directory recursion that I developed. I put this file in my SENDTO directory so that I can right-click on a directory name and select this script file from the
Send to
context menu.
Option Explicit
'
' CreateDirectoryListing.VBS
' ===========================
' Mike Meinz
' 11 Janury 2004
'
'
Const TemporaryFolder = 2
CONST THEFILENAME="_DirectoryListing.TXT"
Const MinWidth = 36
'
Dim objTempFolder
Dim objArgs
Dim objLogFSO
Dim objLogFile
Dim wshShell
Dim strFileName
'
Sub ProcessItem(ByVal objItem, ByVal intMax)
Dim strAttr
strAttr = Space(4)
If objItem.Attributes And 1 Then
strAttr = "R " ' ReadOnly
End If
If objItem.Attributes And 2 Then
strAttr=LEFT(strAttr, 1) & "H " ' Hidden
End If
If objItem.Attributes And 4 Then
strAttr=LEFT(strAttr, 2) & "S " ' System
End If
If objItem.Attributes And 32 Then
strAttr=LEFT(strAttr,3) & "A" ' Archive
End If
Call LogIt( _
Left(objItem.Name & Space(intMax), intMax) & vbTab & _
objItem.DateCreated & vbTab & _
objItem.DateLastModified & vbTab & _
objItem.Size & vbTab & _
strAttr & vbTab & _
objItem.Type, True)
End Sub
'
Sub ProcessFiles(ByVal strFolderSpec)
Dim objFSO
Dim objFolder
Dim objFileCollection
Dim objFolderCollection
Dim objItem
Dim objSubFolder
Dim strAttr
Dim intMax
Call LogIt(strFolderSpec, True)
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Err.Clear
Set objFolder = objFSO.GetFolder(strFolderSpec)
If Err.Number = 0 Then
On Error GoTo 0
Set objFileCollection = objFolder.Files
For Each objItem In objFileCollection
' Determine Maximum FileName size
If intMax < Len(objItem.Name) Then
intMax = Len(objItem.Name)
End If
Next
If intMax < MinWidth Then
intMax = MinWidth ' Minimum Size is MinWidth
End If
For Each objItem In objFileCollection
Call ProcessItem(objItem, intMax)
Next
Call LogIt("", True)
Set objFolderCollection = objFolder.SubFolders
For Each objSubFolder In objFolderCollection
Call ProcessFiles(objSubFolder.Path)
Next
Set objItem = Nothing
Set objFileCollection = Nothing
Set objSubFolder = Nothing
Set objFolderCollection = Nothing
Else
MsgBox "GetFolder Error" & vbNewLine & _
Err.Description & "(" & Err.Number & ")" & vbNewLine & _
strFolderSpec, vbCritical
On Error GoTo 0
End If
Set objSubFolder = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub
Sub LogIt(ByVal strMessage, ByVal bNewLine)
If bNewLine Then
objLogFile.WriteLine strMessage
Else
objLogFile.Write strMessage
End If
End Sub
'**********************************************************************
' Starts Here
'
Set objArgs = WScript.Arguments
Set objLogFSO = CreateObject("Scripting.FileSystemObject")
Set objTempFolder = objLogFSO.GetSpecialFolder(TemporaryFolder)
Set objLogFile = objTempFolder.CreateTextFile(THEFILENAME,True,True)
strFileName = objTempFolder.path & "\" & THEFILENAME
Call LogIt(Left("FileName" + Space(MinWidth), MinWidth) & vbTab & _
LEFT("DateCreated"+SPACE(20),20) & vbTab & _
LEFT("DateLastModified"+SPACE(20),20) & vbTab & _
"Size" & vbTab & _
"Attr" & vbTab & _
"FileType", True)
Call ProcessFiles(objArgs(0))
objLogFile.Close
Set objLogFile = Nothing
Set wshShell = CreateObject("WScript.Shell")
wshShell.CurrentDirectory=objTempFolder.path
wshShell.Run ("Notepad.exe " & strFileName)
Set objTempFolder=Nothing
Set objLogFSO = Nothing
Set wshShell = Nothing
Set objArgs = Nothing
'
' Ends here
'