'---------------------------------------------------------
'Written by Vic Laurie, January, 2006
'All rights reserved. Provided as is
'with no guarantees, express or implied
'User assumes all responsibility
'---------------------------------------------------------
'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
.............
Dont not take below the .......... copy and save as .vbs