'**********************************************
'* GetListFiles.vbs
'*---------------------------------------------
'* Скрипт получения списка файлов 
'*---------------------------------------------
'* Programming by VerSys, 2008 
'**********************************************
Option Explicit
'
'Переменные и константы
 Public strPath      'Патч текущих диска, папки, подпапки
 Public strSeparator 'Строка-разделитель списка
 Public strSpace     'Строка с заданным количеством пробелов
 Public strBuffer    'Строка-накопитель сведений о папках, файлах
 Dim strFileName     'Имя файла отчета
 Const strHead = "Выберите диск или папку:"
'
'объектные переменные
  Dim objShell
  Dim objDialogFolder    
  Dim objDialogFolderItem
  Dim objFolder
  Dim objFolderItem
  Dim objFSO
'инициализация переменных
   strSeparator = String(40, "-")
   strSpace = Space(3)
'--------------------------------------------------------------
'Формируем диалоговое окно "Обзор папок" 
 Set objShell = CreateObject("Shell.Application") 'Объект Shell    
 Set objDialogFolder = objShell.Namespace(&H11&)  'Name_Space = "Мой компьютер",
 Set objDialogFolderItem = objDialogFolder.Self   'и устанавливаем по умолчанию в диал.окне
     strPath = objDialogFolderItem.Path
'
'Выводим диалоговое окно "Обзор папок" 
 Set objFolder = objShell.BrowseForFolder(0,strHead,0,strPath) 
'
'Если ничего не выбрано - завершаем скрипт      
 If objFolder Is Nothing Then
    Wscript.Quit
 End If
'
'Если пользователь выбрал диск или папку:
''получаем патч из диалога
  Set objFolderItem = objFolder.Self
      strPath = objFolderItem.Path
'
''создаем File System Object
  Set objFSO = CreateObject("Scripting.FileSystemObject")
'
''проверяем доступность указанного ресурса
 If objFSO.FolderExists(strPath) = False Then
    MsgBox "Нет доступа к ресурсу ''" &  strPath & "''",_
           vbOkOnly + vbCritical, strPath
    Wscript.Quit
 End If
'
''вызываем функцию прохода по каталогам и файлам
  dhGetListFolderFile(strPath)
'
''Создаем файл отчета
'''Формируем имя файла отчета как строка патча с заменой недопустимых символов
    strFileName = Replace(Replace(strPath, ":\", "-"), "\", "=")
    strFileName = strFileName & ".txt" 
'''Результат пишем в файл 
    With objFSO.CreateTextFile(strFileName)
     .WriteLine(strBuffer)
     .Close
    End With 
'
'Уничтожаем объекты
 Set objShell = Nothing
 Set objDialogFolder = Nothing
 Set objDialogFolderItem = Nothing
 Set objFolder = Nothing
 Set objFolderItem = Nothing
 Set objFSO = Nothing
'
'Сообщаем о создании отчета
 MsgBox "Отчет создан в файле:" & Chr(13) &_
        "''" & strFileName & "''", vbOkOnly + vbInformation, strPath
'
'--------------------------------------------------------------
' FUNCTION'S
'--------------------------------------------------------------
Function dhGetListFolderFile(strFolderName)
'Функция прохода по каталогам и файлам
 Dim dFolder, dFile, dSubFolder 
   'получаем патч каталога
    Set dFolder = objFSO.GetFolder(strFolderName)
    'проходим файлы текущего каталога
        strBuffer = strBuffer & strFolderName & " <DIR>" & vbNewLine
    For Each dFile In dFolder.Files
        strBuffer = strBuffer & strSpace & dFile.Name & " - " & dFile.Size & vbNewLine
    Next
        strBuffer = strBuffer & strSeparator & vbNewLine
    'проходим рекурсивно по всем подкаталогам
    For Each dSubFolder In dFolder.SubFolders
        dhGetListFolderFile(dSubFolder.Path)
    Next
End Function