Gavigor
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Вот готовый скрипт (респект alexii с http://forum.script-coding.info/profile.php?id=1844):
Замечание: найденные файлы будут копироваться не в папку скрипта, а во вновь создаваемую папку со случайным именем. Это сделано специально для упрощения и ускорения работы.
Код:
Option Explicit
Dim objFSO
Dim objDrive
Dim strFileName4Find
Dim strPath4Copy
Dim i
ReDim arrPaths(0) ' Динамический массив для найденных путей
strFileName4Find = "test.txt" ' Имя файла для поиска.
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
arrPaths(LBound(arrPaths)) = False ' Первый элемент массива - флаг результата поиска.
For Each objDrive In objFSO.Drives ' Перебираем все существующие тома.
If objDrive.DriveType = 2 Then ' Том фиксированный?
If objDrive.IsReady Then ' Том готов?
WScript.Echo "Find on drive " & objDrive.DriveLetter & ":..."
FindInSubFolders objDrive.RootFolder, strFileName4Find ' Вызываем процедуру поиска
' для корневой папки этого тома.
' Обработка вложенных папок будет
' вестись рекурсивно.
End If
End If
Next
If arrPaths(LBound(arrPaths)) Then ' Файл(ы) был(и) найден(ы)?
strPath4Copy = GetRandomSubFolderName( _
objFSO.GetFile(WScript.ScriptFullName).ParentFolder) ' Получаем случайное имя папки для копирования.
objFSO.CreateFolder strPath4Copy ' Создаём эту папку.
WScript.Echo
WScript.Echo "Found paths for file [" & strFileName4Find & "]:"
WScript.Echo "------------------------------------------------------------"
For i = LBound(arrPaths) + 1 To UBound(arrPaths) ' Выводим все найденные пути.
WScript.Echo arrPaths(i)
With objFSO
.CopyFile arrPaths(i), .BuildPath(strPath4Copy, _
.GetBaseName(arrPaths(i)) & " (" & CStr(i) & ")." & _
.GetExtensionName(arrPaths(i))) ' Копируем найденные файлы в созданную папку
' под именем «<старое имя> (<номер>).<расширение>»
End With
Next
WScript.Echo "------------------------------------------------------------"
WScript.Echo
WScript.Echo "Files was copyed to folder [" & strPath4Copy & "]."
Else
WScript.Echo "Not found paths for file [" & strFileName4Find & "]."
End If
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub FindInSubFolders(objFolder, strFileName)
Dim objSubFolder
Dim strFullFileName
WScript.Echo objFolder.Path ' Выводим путь обрабатываемой папки (для
' отладки; имеет смысл закомментировать).
strFullFileName = objFSO.BuildPath(objFolder, strFileName) ' Строим полный путь файла.
If objFSO.FileExists(strFullFileName) Then ' Файл существует?
ReDim Preserve arrPaths(Ubound(arrPaths) + 1) ' Увеличиваем размер массива.
arrPaths(LBound(arrPaths)) = True ' Устанавливаем флаг результата поиска.
arrPaths(UBound(arrPaths)) = strFullFileName ' Запоминаем путь.
WScript.Echo "Found file [" & strFileName & "] in folder [" & objFolder.Path & "]."
End If
On Error Resume Next ' Обрабатываем ошибки, возможные в случае,
' когда нет доступа к содержимому папки
' (пример - «System Volume Information».
For Each objSubFolder In objFolder.SubFolders
If Err.Number = 0 Then ' Удалось получить доступ к содержимому папки?
FindInSubFolders objSubFolder, strFileName ' Вызываем процедуру поиска для каждой из подпапок.
Else ' Если не удалось —
Err.Clear ' сбрасываем состояние ошибки и движемся дальше.
WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
End If
Next
On Error Goto 0 ' Восстанавливаем стандартную обработку ошибок
End Sub
'=============================================================================
'=============================================================================
' Based on: VBScript: генерация пути для временного файла
' (http://forum.script-coding.info/viewtopic.php?pid=9523#p9523)
'
Function GetRandomSubFolderName(strFolder)
Dim strTempFolderName
With objFSO
Do
strTempFolderName = .BuildPath(strFolder, .GetTempName)
'если такая папка существует, продолжаем попытки генерации пути:
Loop While .FolderExists(strTempFolderName)
End With
GetRandomSubFolderName = strTempFolderName
End Function
'=============================================================================
|
Всем спасибо! |
Всего записей: 118 | Зарегистр. 27-04-2008 | Отправлено: 01:52 21-09-2009 | Исправлено: Gavigor, 01:53 21-09-2009 |
|
