Submitted By: Steve Yandl

Writes folder contents to text file.

Visual Basic
Edit|Remove
'  I suggest placing this script in a folder, say C:\Scripts
'  Place a shortcut to the script in your SendTo folder
'  This allows you to right click any folder(s) in Windows Explorer
'  and send the folder(s) to the script to output a list of files and subfolders
'  as a text file.

'  If there is no file association set for vbs, shortcut should be to
'  a WScript or CScript command line with this script as
'  the argument.

'  The script also works with drag and drop.
'  Drag and drop a folder on a shortcut with command line
'  WScript.exe C:\Scripts\ThisScript.vbs and the script runs
'  If this option is used, it makes sense to edit the script so
'  if the user simply double clicks without sending an argument
'  a folder browse window might be produced rather than quit the script.
'  If there is a file association set for vbs, folders can be dropped
'  on the actual script rather than a WScript or CScript shortcut.

'  Finally, the script will work from the command line, for example
'  CScript.exe "C:\Scripts\ThisScript.vbs "C:\Test"
'  will document the contents of C:\Test (if it exists)

'  Steve Yandl

' =================================================
' =================================================

Const ForAppending = 8

Dim wsh, fso

'  Only run script if it has been fed
If WScript.Arguments.Count = 0 Then
WScript.Echo "Failed to send the path to any folders"
WScript.Quit
End If

Set fso = CreateObject("Scripting.FileSystemObject")

'  Build an array consisting of folder names sent to the script
fldrsSent = 0
For N = 0 To (WScript.Arguments.Count - 1)
If fso.FolderExists(WScript.Arguments.Item(N)) Then
ReDim Preserve fldrArray(fldrsSent)
fldrArray(fldrsSent) = WScript.Arguments.Item(N)
fldrsSent = fldrsSent + 1
End If
Next

'  Quit if the array does not contain at least one folder name
If Not IsArray(fldrArray)  Then
WScript.Echo "None of the arguments represented an existing folder"
Set fso = Nothing
WScript.Quit
End If

'  Prepare text file to be appended with lists of folder contents
'  Create the text file if it does not already exist
Set wsh = CreateObject("WScript.Shell")
strReportPath = wsh.SpecialFolders("MyDocuments")
Set txtReport = fso.OpenTextFile(strReportPath & "\FolderContents.txt", ForAppending, True, 0)

For D = 0 To UBound(fldrArray)
txtReport.WriteLine "At " & Now & " the folder"
txtReport.WriteLine fldrArray(D)
Set targetFldr = fso.GetFolder(fldrArray(D))

If targetFldr.Files.Count = 0 Then
txtReport.WriteLine "contained no files"
Else
txtReport.WriteLine "contained the file(s): "
For Each includedFile In targetFldr.Files
txtReport.WriteLine vbTab & fso.GetFileName(includedFile)
Next
End If

If targetFldr.Subfolders.Count = 0 Then
txtReport.WriteLine "and no subfolders"
Else
txtReport.WriteLine "and the subfolder(s)"
For Each includedSub In targetFldr.Subfolders
txtReport.WriteLine vbTab & fso.GetFileName(includedSub)
Next
End If

txtReport.WriteLine " "
txtReport.WriteLine "/ / / / / / / / / / / / / / / / / / / / / / / / / "
txtReport.WriteLine " "
Next

txtReport.Close
WScript.Echo "Logged to FolderContents.txt in My Documents folder"

Set wsh = Nothing
Set fso = Nothing