'Description- Lists all files in a selected folder and its subfolders
'that are of a given type selected by user.
'Uses Dir with switches 

Option Explicit
Dim sFldrInput1, sFldrInput2, sExtension, introMsg, sSwitches

introMsg = msgBox ("This program creates a list of all files of a given type"& _
    vbCrLf & "that are in a selected folder and optionally its subfolders." & vbCrLf & _
    "If there are many files, it may take a few minutes."& vbCrLf & _
        "A message will appear when the list is finished.",vbOKCancel)
If introMsg = vbCancel Then
	Wscript.Quit 
End If
ChooseFolder sFldrInput1,"Select the folder containing files to be listed"
ChooseFolder sFldrInput2, "Select the folder where list is to be put"
ChooseExtension sExtension
ChooseSubfldr sSwitches

MakeList sFldrInput1, sFldrInput2, sExtension
Wscript.Quit

sub ChooseFolder(sFldrChoice, sSelectionString)
dim objShell, objFolder, objFolderItem, strPath, msgValue
Const DESK_TOP = &H10&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
sFldrChoice = ""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(DESK_TOP)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, sSelectionString, OPTIONS, strPath) 
      
If objFolder Is Nothing Then
    Wscript.Quit
End If

Set objFolderItem = objFolder.Self
sFldrChoice = objFolderItem.Path

msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
If msgValue = vbCancel Then
	Wscript.Quit
End If
If Len(sFldrChoice) = 3 then 
   chkForDrv sFldrChoice
End if
End sub

Sub ChooseExtension(sExtension)
sExtension = InputBox("Enter extension of files to be listed.", "Name of extension")
If sExtension = "" Then
    Wscript.Quit
End If
chkForDot sExtension
End sub

Sub MakeList(sourceFldr, listFldr, Extension)
Const sdirCmd ="cmd /c dir "
Const sWildCard = "\*."
Const sRedirect =">"
dim listFile 
dim sStatement
dim objWshell
Dim oIE, oIEDoc, sMsg
listFile ="\list" & Extension & ".txt"
sStatement = sdirCmd & chr(34) & sourceFldr & sWildcard & Extension & chr(34) & sSwitches _
    & sRedirect & chr(34) & listFldr & listFile & chr(34)

'The next part is just to display a message while making list
set objWshell=Wscript.CreateObject("Wscript.Shell")
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.height=200
oIE.width=300
oIE.Resizable = False
oIE.Visible = True
sMsg= "<p><center>List is being made.<br>Please wait.<br>Large numbers of files may " & _
    "take several minutes.</center></p>"
oIEDoc.Body.Innerhtml= sMsg
 'List the files
objWshell.Run sStatement,7,true

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
set objWshell = Nothing
msgBox "List has been made of " & sExtension & " files"
End sub

Sub chkForDrv(sFldrChoice)
Dim oRe, bMatch
set oRe = New RegExp
oRe.pattern = "[a-zA-Z]:\\$"
bMatch= oRe.Test(sFldrChoice)
If bMatch Then sFldrChoice= Left(sFldrChoice, 2)
Set oRe = Nothing
End sub

Sub chkForDot(sExtension) 
Dim lenExt, truncStr
lenExt = Len(sExtension)
truncStr =left(sExtension,1)
If truncStr = "." then
    sExtension = right(sExtension,lenExt-1)
End if 

End sub

Sub ChooseSubfldr(sSwitches)
dim sSubfldrYesNo
sSubfldrYesNo = msgBox("Do you want to list files in all subfolders also?", _
    vbYesNoCancel+vbQuestion)
Select Case sSubfldrYesNo
case vbCancel 
  Wscript.Quit
case vbNo 
  sSwitches = " /o:g"
case vbYes 
   sSwitches = " /o:g /s"
End select
end sub