Скрипт VBS выводит список jpeg

Задача: создать текстовый файл и в него записать список файлов jpeg из указанной папки и всех его подпапок.

Решение:

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, strExt, objFSO
‘получаем патч каталога
Set objFSO = WScript.CreateObject(«Scripting.FileSystemObject»)
Set dFolder = objFSO.GetFolder(strFolderName)
‘проходим файлы текущего каталога
For Each dFile In dFolder.Files
if (Right(dFile.Type,4))= «JPEG» then
strBuffer = strBuffer & strFolderName & «\» & dFile.Name & » – » & dFile.Size & » – » & dFile.Type & vbNewLine
end if
Next
‘проходим рекурсивно по всем подкаталогам
For Each dSubFolder In dFolder.SubFolders
dhGetListFolderFile(dSubFolder.Path)
Next
End Function
  • 0
  • 29 октября 2011, 13:16
  • admin

Комментарии (0)

RSS свернуть / развернуть
Только зарегистрированные и авторизованные пользователи могут оставлять комментарии.
Яндекс.Метрика