Hi RangerRon,
I developed the VBScript file included below to create a directory listing
into a TXT file ready for printing or for copying and pasting into Excel or
Word in case you want more formatting.
To install this VBScript on you computer
1. Start Notepad
2. Copy and paste everything below the line of "_' below up until the
"Ends Here" comment into Notepad.
3. In Notepad, use File, Save As and navigate to the C:\Documents and
Settings\<UserName>\SendTo Folder.
The SendTo folder within your username's directory may be hidden
so you
may have to type SENDTO in the filename field of the NotePad
Save As dialog box.
4. After you have navigated to the SendTo folder, enter
"CreateDirectoryListing.VBS" in the filename textbox and click
the Save button.
To use the "CreateDirectoryList.VBS" VBScript file
1. With Windows Explorer navigate to a directory, then Right-Click on
the directory name.
2. From the list of available SendTo targets, choose
"CreateDirectoryListing.VBS".
3. The VBScript will run and, when finished, will start NotePad loading
the contents _
of the "_DirectoryListing.txt" file that was created by the
VBScript.
4. When finished editing and/or printing, save the file or
exit Notepad and drag-and-drop the "_DirectoryListing.txt" file
onto the Recycle bin.
I find it best to print the directory listing in Landscape mode.
Following is a VBScript (VBS) to create a listing of all files (and file
attributes) in a directory and its subdirectories:
_________________________________________________
Option Explicit
'
' CreateDirectoryListing.VBS
' ===========================
' Mike Meinz
' 11 Janury 2004
' Brooklyn Park, MN
'
'
Const ForWriting = 2
Const MinWidth = 36
Dim objArgs
Dim objLog
Dim objLogFile
Dim wshShell
Dim strFileName
'
Sub ProcessItem(ByVal objItem, ByVal intMax)
' Create a line with all of the information about one file
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)
' Process a directory
' ProcessFiles is called recusively to process directories within
directories
Dim objFSO
Dim objFolder
Dim objFileCollection
Dim objFolderCollection
Dim objItem
Dim objSubFolder
Dim strAttr
Dim intMax
' Output the name of the directory (aka folder)
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
' Determine maximum length of a filename
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
' Process each file in the current directory
For Each objItem In objFileCollection
Call ProcessItem(objItem, intMax)
Next
Call LogIt("", True) ' Output a space after a directory's files
Set objFolderCollection = objFolder.SubFolders
' Process each subdirectory within the current directory
For Each objSubFolder In objFolderCollection
' Recursive call to process a subdirectory
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
Function GetLogFileName(ByVal s)
If Right(s, 1) <> "\" Then
s=s & "\"
End if
GetLogFileName = s & "_DirectoryListing.TXT"
End Function
'
' Starts Here
'
Set objArgs = WScript.Arguments
Set objLog = CreateObject("Scripting.FileSystemObject")
strFileName = GetLogFileName(objArgs(0))
Set objLogFile = objLog.OpenTextFile(strFileName, ForWriting, True)
' First line of the output file is the column headings
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)
' Process the selected directory.
' objArgs(0) contains the name of the directory.
Call ProcessFiles(objArgs(0))
objLogFile.Close
Set objLogFile = Nothing
Set objLog = Nothing
Set wshShell = CreateObject("WScript.Shell")
wshShell.Run ("notepad.exe " & strFileName)
Set wshShell = Nothing
Set objArgs = Nothing
'
' Ends here
'
'----------------------------
