Поиск и замена файлов.

[Drotik]

Вообщем у меня такая проблема!

Нужно зделать так чтобы искало по всем разделам и найденые файлы заменяло файлом из пути указаной в скрипте.

Есть два скрипта у меня и никак не получаеться их связать.

Первый скрипт ищет файлы и удаляет их
Второй скрипт ищет файл и заменяет только первый найденый
А мне нужно заменять все найденые файлы на всех разделах.



Option Explicit
'Dim objArgs
Dim strFileName

'If Not WScript.Arguments.Named.Exists("FileName") Then
' WScript.Echo "Using: " & WScript.ScriptName & " /FileName:<file for find>"
' WScript.Quit 1
'End If

'strFileName = WScript.Arguments.Named.Item("FileName")

strFileName = "help.txt" ' — имя файла для поиска писать здесь
Dim objFSO
Dim objDrive
ReDim arrPaths(0)
Dim i
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
FindInSubFolders objDrive.RootFolder, strFileName
End If
End If
Next
If arrPaths(LBound(arrPaths)) Then
'WScript.Echo "" & strFileName & ""
For i = LBound(arrPaths) + 1 To UBound(arrPaths)
'WScript.Echo arrPaths(i)


objFSO.DeleteFile arrPaths(i)


Next
Else
WScript.Echo "Not found paths for file [" & strFileName & "]."
End If
Set objFSO = Nothing
WScript.Quit 0

Sub FindInSubFolders(objFolderForFind, strFileName)
Dim objFolder
'WScript.Echo objFolderForFind.Path
If objFSO.FileExists(objFSO.BuildPath(objFolderForFind, strFileName)) Then
ReDim Preserve arrPaths(Ubound(arrPaths) + 1)
arrPaths(LBound(arrPaths)) = True
arrPaths(UBound(arrPaths)) = objFSO.BuildPath(objFolderForFind, strFileName)
'WScript.Echo "Found file [" & strFileName & "] on folder [" & objFolderForFind.Path & "]"
End If
On Error Resume Next
For Each objFolder In objFolderForFind.SubFolders
If Err.Number = 0 Then
FindInSubFolders objFolder, strFileName
Else
Err.Clear
'WScript.Echo "Can't enumerate subfolders for folder [" & objFolderForFind.Path & "]"
End If
Next
On Error Goto 0
End Sub

Option Explicit


Dim objFSO
Dim objDrive
Dim strFileNameForFind
Dim boolDone


strFileNameForFind = "help.txt" ' Имя файла для поиска.

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objDrive = objFSO.GetDrive("h:") ' Буква Раздела

WScript.Echo "Find on drive " & objDrive.DriveLetter & ":..."

boolDone = False
ScanSubFolders objDrive.RootFolder, strFileNameForFind ' Вызываем процедуру поиска
' для корневой папки этого тома.
' Обработка вложенных папок будет
' вестись рекурсивно.

Set objDrive = Nothing
Set objFSO = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder, strFileName)
Dim objSubFolder
Dim strFullFileName

' Выводим путь обрабатываемой папки (для
' отладки; имеет смысл закомментировать).

strFullFileName = objFSO.BuildPath(objFolder.Path, strFileName) ' Строим полный путь к файлу.

If objFSO.FileExists(strFullFileName) Then ' Файл существует?
WScript.Echo vbTab & "Found as [" & strFullFileName & "], copying..."

' Копируем файл
objFSO.CopyFile objFSO.BuildPath("d:\", strFileName), strFullFileName, True
boolDone = True

Exit Sub
End If

On Error Resume Next ' Обрабатываем ошибки, возможные в случае,
' когда нет доступа к содержимому папки
' (пример - «System Volume Information».
For Each objSubFolder In objFolder.SubFolders
If Err.Number = 0 Then ' Удалось получить доступ к содержимому папки?
On Error Goto 0 ' Восстанавливаем стандартную обработку ошибок

If Not boolDone Then
ScanSubFolders objSubFolder, strFileName ' Вызываем процедуру поиска для каждой из подпапок.
End If
Else ' Если не удалось —
Err.Clear ' сбрасываем состояние ошибки,
On Error Goto 0 ' восстанавливаем стандартную обработку ошибок и движемся дальше.
WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
End If
Next
End Sub

[amel27]

чтобы искало по всем разделам и найденые файлы заменяло файлом из пути указаной в скрипте »
WScript.Echo FindReplaceFileByName ("file.txt","C:\TEST\test.txt")

Function FindReplaceFileByName (strFileName, strFilePath)
Dim FSO, WMI, col, obj, str

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WMI = GetObject("winmgmts:\\.\root\cimv2")

For Each obj In FSO.Drives
If obj.DriveType=2 And obj.IsReady Then
str = str &"Drive='"& obj.DriveLetter &":' OR "
End If
Next

For Each obj In WMI.ExecQuery("SELECT Name From CIM_DataFile Where ("& Mid(str,1,Len(str)-4) &") AND Name LIKE '%\\"& strFileName &"'")
' WScript.Echo obj.Name
FSO.CopyFile strFilePath, obj.Name, vbTrue
FindReplaceFileByName = FindReplaceFileByName + 1
Next
End Function

[X.509]

WScript.Echo FindReplaceFileByName ("file.txt","C:\TEST\test.txt")
Function FindReplaceFileByName (strFileName, strFilePath)
Dim FSO, WMI, col, obj, str
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
For Each obj In FSO.Drives
If obj.DriveType=2 And obj.IsReady Then
str = str &"Drive='"& obj.DriveLetter &":' OR "
End If
Next
For Each obj In WMI.ExecQuery("SELECT Name From CIM_DataFile Where ("& Mid(str,1,Len(str)-4) &") AND Name LIKE '%\\"& strFileName &"'")
' WScript.Echo obj.Name
FSO.CopyFile strFilePath, obj.Name, vbTrue
FindReplaceFileByName = FindReplaceFileByName + 1
Next
End Function »
а как сделать так чтоб скрипт работал по маске?
например есть куча файлов с расширением *.jpg на наске С: и файл с тем же расширением на флэшке. Нужно что бы при запуске, скрипт копировал файл с флэшки и заменял найденые по маске + сохранял имя файла. Возможно ли такое?