Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Старожил


Сообщения: 175
Благодарности: 119

Профиль | Отправить PM | Цитировать


Код: Выделить весь код
Option Explicit
 
Dim objFSO 
Dim objShApp
Dim objWshSh
Dim strMask
Dim CurrFolderPath
Dim strFileP
Dim OpenFile
Dim nLine
Dim strLine(2)
Dim strRepl(2)
 
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 
Set objShApp = WScript.CreateObject("Shell.Application")
Set objWshSh = CreateObject("WScript.Shell")

' поместите файл скрипта в каталог, который нужно обработать
CurrFolderPath = objWshSh.CurrentDirectory
' маска обрабатываемых файлов
strMask = "*.txt; *.htm"
' файл-образец для замены
strFileP = "z:\list.txt"
' заменяемые выражения
strRepl(0) = "_something1_"
strRepl(1) = "_something2_"
strRepl(2) = "_something3_"

Set OpenFile = objFSO.OpenTextFile(strFileP, 1)
  Do Until OpenFile.AtEndOfStream = True Or nLine = 2
      nLine = OpenFile.Line - 1
      strLine(nLine) = OpenFile.ReadLine
  Loop
OpenFile.Close

If nLine < 2 Then
  MsgBox "Некорректный файл-образец"
Else
  GetFiles objFSO.GetFolder(CurrFolderPath)
End If

Set objFSO = Nothing
Set objShApp = Nothing
Set objWshSh = Nothing

MsgBox "Скрипт завершил обработку каталога"

WScript.Quit 
 
Sub GetFiles(objFolder) 
  Dim SubFolderItem
    ReplaceTextToFiles(objFolder.Path)
    For Each SubFolderItem In objFolder.SubFolders
      GetFiles SubFolderItem 
    Next 
End Sub 
 
Sub ReplaceTextToFiles(strPath) 
  Dim arrFiles
  Dim i, n
  Dim strItemFile
  Dim strText   
    Set arrFiles = objShApp.NameSpace(strPath).Items 
    arrFiles.Filter 192, strMask
    For i = 0 To arrFiles.Count - 1
      strItemFile = arrFiles.Item(i).Path
      Set OpenFile = objFSO.OpenTextFile(strItemFile, 1)
        strText = OpenFile.ReadAll
      OpenFile.Close
      For n = 0 To 2
        strText = Replace(strText, strRepl(n), strLine(n), 1, -1, 1)
      Next
      Set OpenFile = objFSO.OpenTextFile(strItemFile, 2)
        OpenFile.Write strText
      OpenFile.Close
    Next
End Sub

Последний раз редактировалось SendMessage, 24-06-2012 в 08:39. Причина: Добавлен финальный MsgBox

Это сообщение посчитали полезным следующие участники:

Отправлено: 08:31, 24-06-2012 | #6